Home » ワードマクロ・Word VBAの使い方 » フォント » フォント名を取得するWordマクロ

フォント名を取得するWordマクロ

対象:Word2007, Word2010, Word2013

「ワードvbaマクロ フォント名」
という検索で、このサイト・インストラクターのネタ帳へのアクセスがありました。

フォント名を取得するWord VBA(Visual Basic for Applications)のコード、マクロを探していた検索です。

フォント名を取得するサンプルコード

FontオブジェクトのNameプロパティを使えば、フォント名を取得することができます。

例えば、
 MsgBox Selection.Font.Name
で、カーソル位置のフォント名がメッセージボックスに表示され、
 MsgBox ActiveDocument.Range(0, 1).Font.Name
で、アクティブな文書の1文字目のフォントの名前がメッセージボックスに表示されます。

これだけでは、あれなので、実務で使えそうなマクロをご紹介しておきましょう。

[スポンサードリンク]

文書で使われているフォントの名前をすべて取得するサンプルマクロ

文書内で使われている、すべてのフォントの名前を取得するマクロです。

Sub 本文で使われている全フォント名を取得する()

 Dim dic As Object  ' Scripting.Dictionary
 Dim chr As Range  ' Charactes.Item
 Dim fnt As Variant  ' フォント名
 Dim msg As String

 Set dic = CreateObject("Scripting.Dictionary")

 On Error Resume Next
 For Each chr In ActiveDocument.Characters
  dic.Add _
   Key:=chr.Font.Name, _
   Item:=""
 Next chr
 On Error GoTo 0

 msg = ""
 For Each fnt In dic.Keys
  msg = msg & fnt & vbCrLf
 Next fnt

 Set dic = Nothing

 MsgBox _
  "この文書の本文で以下のフォントが使われています。" _
  & vbCrLf & vbCrLf & msg

End Sub

上記のマクロを実行すると、アクティブな文書の本文で使われているフォント名がメッセージボックスに表示されます。

上記のマクロでは本文だけを調べていますので、図形内の文字列やヘッダー・フッターも調べたいという場合は、別途処理を追加してください。

サンプルマクロの解説

上記のマクロでは、DocumentオブジェクトのCharactersコレクションオブジェクトから、1文字ずつRangeオブジェクトを取得するFor Each~Nextループを回しています。
 For Each chr In ActiveDocument.Characters

なお、Charactersコレクションオブジェクトのメンバーである単一オブジェクトはRangeオブジェクトですから、

フォント名を取得するWordマクロ

この、
 For Each chr In ActiveDocument.Characters
で使うオブジェクト変数は、
 Dim chr As Range
と、Rangeで宣言しています。

このFor Each~Nectループの中であれば「chr.Font.Name」というオブジェクト式で、1文字ずつフォント名を取得できます。(先にご紹介した「.Range(0, 1).Font.Name」というオブジェクト式と同じ考え方です)

課題は、フォント名を重複なしでどう取得するか、です。

この課題を解決するためにここでは、Scripting.DictionaryオブジェクトのAddメソッドで指定するKeyに、

フォント名を取得するWordマクロ

重複した値を指定するとエラーになる、という特徴を利用しています。

以下のコードを実行するとDictionaryオブジェクトのKeyにフォント名が格納されていきますが、
 Set dic = CreateObject("Scripting.Dictionary")
 For Each chr In ActiveDocument.Characters
  dic.Add _
   Key:=chr.Font.Name, _
   Item:=""
同じフォント名が格納済みだったときにはエラーが発生します。

これを逆手にとって、
 On Error Resume Next
 For Each chr In ActiveDocument.Characters
のように、エラーを無視して、とにかくFor Each~Nextループを回すことで、重複のない全フォント名のリストをDictionaryオブジェクトとして作っています。

その後、DictionaryオブジェクトのKeyからフォント名を取り出して、メッセージボックスに表示するメッセージを作成して、
 msg = ""
 For Each fnt In dic.Keys
  msg = msg & fnt & vbCrLf
 Next fnt

最後にメッセージボックスを表示しています。
 MsgBox _
  "この文書の本文で以下のフォントが使われています。" _
  & vbCrLf & vbCrLf & msg

[スポンサードリンク]

Home » ワードマクロ・Word VBAの使い方 » フォント » フォント名を取得するWordマクロ

Copyright © インストラクターのネタ帳 All Rights Reserved.

.