フォントが存在するかどうかを判定するFunction [Word]

指定したフォントの存否を調べるFunction

指定したフォントが存在するかどうかをどうやって調べるのか

だいぶ前に、超有名なOffice TANAKA さんのサイトで、

フォントの一覧を取得するマクロ

というものを見たことがあった。

んで、単純にこれをWordに移植できないものか、やってみたら……。

f:id:akashi_keirin:20180121174228j:plain

「実行時エラー438」というエラーが吐かれる。

どうも、Wordのフォント選択コンボボックスは、Excelとは指定の仕方が異なる模様。でもこんなの、どうやって調べたらいいんだろう……。

ちょっと素人の私には手がでないので、別の方法を考えた。

Excelを呼んで強引に解決する

題名の通りの力業ですw

VBEの「ツール」→「参照設定」から、「Microsoft Excel 1x.x Object Library」にチェックを入れておきましょう。

リスト1 標準モジュール
Public Function hasFont(ByVal nameOf As String) As Boolean
  Dim xlApp As New Excel.Application    '……(1)'
  xlApp.Visible = False
  Dim xlBook As Excel.Workbook    '……(2)'
  Set xlBook = xlApp.Workbooks.Add
  Dim i As Integer
  With xlApp.CommandBars("Formatting").Controls(1)    '……(3)'
    For i = 1 To .ListCount    '……(4)'
      If nameOf = .List(i) Then hasFont = True: Exit For    '……(5)'
      If i = .ListCount Then hasFont = False    '……(6)'
    Next
  End With
  xlBook.Close False    '……(7)'
  xlApp.Quit
  Set xlBook = Nothing
  Set xlApp = Nothing
End Function

まず、(1)の

Dim xlApp As New Excel.Application

で、Excel.Applicationのインスタンスを生成。

(2)からの2行

Dim xlBook As Excel.Workbook
Set xlBook = xlApp.Workbooks.Add

で新規ブックを作成し、変数xlBookにぶち込む。

これをすることによって、画面にExcelのブックが表示されてしまう。うっとうしいんだけれど、これをしないと、

f:id:akashi_keirin:20180121174322j:plain

こんなふうに、ListCountメソッドが失敗してしまう。

ちなみに、このときに、イミディエイトで

xlApp.Visible = True

としてExcelを表示させてみると、

f:id:akashi_keirin:20180121174332j:plain

このようになっていて、フォント選択のコンボボックスは死んでいる……というかまだ生まれていないみたい。

(3)からの6行

With xlApp.CommandBars("Formatting").Controls(1)
  For i = 1 To .ListCount    '……(4)'
    If nameOf = .List(i) Then hasFont = True: Exit For    '……(5)'
    If i = .ListCount Then hasFont = False    '……(6)'
  Next
End With

ExcelのCommandbars("Formatting").Controls(1)オブジェクトのListプロパティを参照して、引数nameOfで渡したフォント名と比較する。

(4)の

For i = 1 To .ListCount

では、Forループの終了値をListCountプロパティの値にしている。ちなみに、Intellisenseは働かないので、そのつもりで。

(5)の

If nameOf = .List(i) Then hasFont = True: Exit For

では、引数nameOfで渡されたフォント名と、Listプロパティで得られたフォント名を比較し、一致すればTrueをreturnしてForループから抜けるようにしている。

(6)の

If i = .ListCount Then hasFont = False

では、 i がListCountプロパティの値になってここにたどり着くということは、一致するフォント名がなかった、ということなので、Falseをreturnすることにしている。

Forループを抜けた時点で、このFunctionがreturnする値は決まっているので、(7)からの4行

xlBook.Close False
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing

で終了処理。

使ってみる

次のコードで実験。

スト2 標準モジュール
Public Sub testHasFont()
  Debug.Print hasFont("ち~んw")    '……(1)'
  Debug.Print hasFont("MS ゴシック")    '……(2)'
End Sub

(1)では、存在するはずのないフォント名「ち~んw」を、(2)では確実に存在する「MS ゴシック」を引数として渡して、結果をイミディエイトに出力させてみた。

当然、False、Trueの順で表示されるはずだ。

実行結果

f:id:akashi_keirin:20180121174344j:plain

見込み通りの結果となった。

おわりに

でも、絶対にWordだけでもできるはずだよなあ……。