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メソッドでファミリー名を抜き出しているだけです。

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

関連記事

  1. Office関連

    指定したフォルダ内の画像ファイルを一括挿入するPowerPointマクロ

    大量の画像ファイルを1枚/1スライドで挿入する必要があり、…

  2. Office関連

    マクロでリボンを最小化する。

    mougの回答用に書いたコードです。忘れないうちにメモ。・…

  3. Office関連

    MDB(Accessデータベース)ファイルを作成してデータを格納するExcelマクロ

    2012/2/22追記:下記で作成したMDBファイルを利用したWo…

  4. Office関連

    [Excel Services ECMAScript]アクティブセルが変更されたときのイベントを利用…

    埋め込んだExcelワークブックの、アクティブセルが変更されたときのイ…

  5. Office関連

    すべてのテーブルの結合を解除するWordマクロ

    すべてのテーブルのセル結合を解除するWordマクロを考えてみました(W…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP