Office関連

インストールされたフォントの一覧を取得するVBAマクロ

最近自分の周りでPowerPoint VBAが流行っているようだったので、新しい記事をググったところ、chemiphys氏のブログが更新されていました。

PowerPointではフォント選択のコンボボックスからフォントを取得できない問題について書かれていて、確認してみると、たしかにListCountプロパティは「0」になっていて、中身は何も無さそうです。
(余談ですが、コマンドバーの操作をする場合、インデックスで指定するよりアプリケーションのバージョンに依存しないIDで指定することをお薦めします。)

Public Sub Sample01()
  Dim cb As CommandBarComboBox
  
  Set cb = Application.CommandBars.FindControl(Id:=1728) 'フォント
  Debug.Print "ListCount:" & cb.ListCount
End Sub

念のためコマンドバーに追加したフォントコンボボックスを表示させてみましたが、やはり中身はすっからかんです。

Public Sub Sample02()
  With Application.CommandBars.Add(Position:=msoBarPopup, Temporary:=True)
    .Controls.Add Id:=1728, Temporary:=True 'フォント
    .ShowPopup
    .Delete
  End With
End Sub

コマンドバーはOffice 2003以前のレガシーなインターフェースですので、処理ができなくなっていても不思議ではなく、むしろ逆に、コマンドバーからフォントが取得できるExcelやWordの方がおかしいといっても過言ではないのかもしれません。

今のインターフェースであるリボン上の「フォント」コンボボックスから、UI AutomationやMSAAを使ってフォントの一覧を取得することも恐らくできますが、処理が複雑になるため、あまりお薦めはできません。

そこで、コンボボックスから取得するのではない、全く別の方法を考えてみました。

Public Sub ListInstallFonts()
  Dim itm As Object
  Const CSIDL_FONTS = 20
  
  With CreateObject("Shell.Application").Namespace(CSIDL_FONTS)
    For Each itm In .Items
      Debug.Print .GetDetailsOf(itm, 8)
    Next
  End With
End Sub

といっても仕組みは単純で、NameSpaceメソッドでFontsフォルダを取得し、中にあるフォントファイルからGetDetailsOfメソッドでファミリー名を抜き出しているだけです。

上記コードで取得できるのは、あくまでも端末にインストールされているフォントだけで、コンボボックス上で表示されるクラウドフォント(「選択してダウンロード」アイコンが表示されているフォント)は取得できませんが、大体の用途には使用できるかと思います。

「みんなで情シス!第2回」に参加してきました。前のページ

【アイカツフレンズ!】フレンズスカウト(友希あいね)に参加しました。次のページ

関連記事

  1. Office関連

    Office クリップボードをマクロで操作する(MSAA)

    MSDNフォーラムに質問がありましたが、Office クリップボードを…

  2. アイコン一覧

    Office 2013 アイコン一覧(Q)

    ・Office 2013 アイコン一覧 NUM…

  3. Office Scripts

    Office Scripts機能によってWeb版Officeの操作を自動化する

    前回、Ignite 2019で発表されたPower Automate(…

  4. Office アドイン

    Ignite 2016で発表されたOffice アドイン関連の情報

    米国時間の9月26~30日にMicrosoftのビッグイベント「Ign…

  5. Office アドイン

    [Office用アプリ]「ActiveViewChanged」イベントと「getActiveView…

    v1.1で追加された、ビューが変更された時に発生するイベント「Acti…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

PAGE TOP