모든 폰트목록 보기 및 클라우드 폰트 일괄 다운로드

 

 

<How to download all cloud fonts in Powerpoint - by listing and using cloud fonts on slides>

 

오피스365 구독버전에서는 클라우드 폰트를 사용합니다.

서버에 항상 폰트가 있기 때문에 해당 폰트를 사용하면  공유하더라도 폰트를 포함할 필요가 없는 장점이 있습니다.

 

그런데 해당 폰트가 사용되어야  혹은 구름모양 아이콘을 눌러서 다운로드해야 로컬에 하나씩 다운받아집니다.

필요할 때 혹은 사용될 때 다운로드 받아지므로 한꺼번에 다운받을 필요는 없으나

조금이라도 작업지연되는 것을 막고자 일괄 다운로드 하고 싶으나 해당 기능은 제공하지 않습니다.

 

이 때 VBA를 이용해서 일괄 다운로드 받는 방법입니다.

(다운로드 받는다고 속도가 빨라지지는 않고 글꼴 목록이 더 많아져서 글꼴목록 로딩이 더 오래 걸리네요-.-;)

 

원래 아래 유투브에서 워드용 매크로를 공개하였습니다.

https://www.youtube.com/embed/DboC5mth678?start=54 

 

또다른 사이트에서는 엑셀용 폰트 목록 가져오는 매크로가 공개되어 있습니다.

https://stackoverflow.com/questions/32080762/get-a-list-of-all-fonts-in-vba-excel-2010

 

이 내용을 파워포인트에서도 워드 개체를 이용해서 만들어 보았습니다.

 
'Option Explicit

Sub AllFonts()

    Dim wd As Object, fontID As Variant
    Dim tr As TextRange, shp As Shape, sld As Slide, pres As Presentation
    Dim i As Integer, SW!, SH!
    
    On Error GoTo Oops
    Set wd = CreateObject("Word.Application")
    
    Set pres = ActivePresentation
    With pres.PageSetup
        SW = .SlideWidth: SH = .SlideHeight
    End With
    
    For Each fontID In wd.FontNames
        
        If i Mod 20 = 0 Then
            Set sld = pres.Slides.Add(pres.Slides.Count + 1, ppLayoutBlank)
            Set shp = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, SW, SH)
            shp.TextFrame.AutoSize = ppAutoSizeNone
        End If
        'Debug.Print fontID
        Set tr = shp.TextFrame.TextRange.InsertAfter(fontID & vbNewLine)
        tr.Font.Name = fontID
        tr.Font.NameFarEast = fontID
        tr.Font.Size = (shp.Height) / 20 - 5
        i = i + 1
    
    Next
    
Oops:
    If Not wd Is Nothing Then wd.Quit: Set wd = Nothing

End Sub

'Excel method
Private Sub UsingExcel()
    
    Dim FontList, i
    
    Set FontList = Application.CommandBars("Formatting").FindControl(Id:=1728)
    
    For i = 1 To FontList.ListCount
        Debug.Print FontList.List(i)
    Next i

End Sub


'word method
Private Sub UsingWord()
    Dim counter, fontID
    counter = 1
    For Each fontID In word.Application.FontNames
    
    ActiveDocument.Content.InsertAfter Text:=fontID
    ActiveDocument.Paragraphs(counter).Range.Font.Name = fontID
    counter = counter + 1
    ActiveDocument.Content.InsertAfter Text:=vbCrLf
    Next fontID
    
End Sub

 

실행하면 아래처럼 여러 슬라이드에 걸쳐 시스템의 모든 폰트목록을 해당폰트를 사용해서 보여줍니다.

슬라이드에 실제 사용되기 때문에 클라우드 폰트는 자동으로 다운로드가 되어집니다.

실행 결과 화면

 

참고로 클라우드 폰트들은 아래 폴더에 숨김 속성으로 저장되어집니다.

C:\Users\<user>\AppData\Local\Microsoft\FontCache\4\CloudFonts\

위 폴더의 ttf 파일을 폰트폴더로 옮길 수도 있겠습니다. (개인적인 용도에 한해)

또한 모두 삭제하면 다시 구름모양 클라우드 폰트로 되돌아갑니다.

 

또한 C:\Users\<user name>\AppData\Local\Microsoft\FontCache\4\Catalog\ListAll.json 파일로 아래와 같은 트리구조로 클라우드 폰트 목록이 존재합니다.

 

이제 클라우드 폰트를 보고 다운로드 하는 것을 테스트해보려면

아래 첨부파일을 매크로 허용해서 열고 Alt-F8로 매크로를 실행하시고 1분 정도 기다리세요.

 

ListAndDownloadAllCloudFonts1.pptm

0.05MB

 

🎃 참고1. 시스템의 중복폰트 제거 방법(How to remove duplicate fonts):

nexus font 를 다운로드 설치하고 도구-중복폰트 찾기 메뉴에서

아래처럼 윈도우의 폴더를 추가하고 찾기 후 해당폰트를 체크하고 삭제하세요.

 

🎃🎃 참고2. Windows 폰트 캐시 초기화 방법:

https://help.extensis.com/hc/en-us/articles/360010243153-How-to-rebuild-the-Font-Cache-in-Windows-Universal-Type-Client-7

 

 

🎃🎃🎃 참고3. 파워포인트 365버전에서 클라우드 폰트를 불러오는 과정에서 폰트 목록이 늦게 뜨는 경우 좀더 빠르게 하는 방법( How to make font listing on Powerpoint 365 faster by not using cloud fonts):

 

클라우드 폰트를 사용하지 않으려면 계정 -설정관리 -선택적 연결환경 켜기에 체크를 해제하면 고 하지만 효과가 없었습니다.

 

이 경우 클라우드 폰트 목록을 특정 파일에 저장하는 것을 위에서 살펴본 바 있습니다. 

이걸 이용해서 아래와 같이 ListAll.json 파일내용을 바꾸고 읽기전용 속성을 주면 클라우드 폰트를 불러오지 않아서 폰트를 불러오는 시간이 3초에서 1초 정도로 빨라지는 효과가 있습니다. (Replace the content of 'ListAll.json' file with the following and make it read-only. Or just empty the file and make it 0 byte. )

<!-- C:\Users\[username]\AppData\Local\Microsoft\FontCache\4\Catalog\ListAll.json -->

{
  "MajorVersion": 4,
  "MinorVersion": 17,
  "Expiration": 0
}

 

Before : about 3 sec to load the font list

 

After : less than 1 sec to load the font list