フォントが存在するかどうかを判定するFunction [Word]
指定したフォントの存否を調べるFunction
指定したフォントが存在するかどうかをどうやって調べるのか
だいぶ前に、超有名なOffice TANAKA さんのサイトで、
フォントの一覧を取得するマクロ
というものを見たことがあった。
んで、単純にこれをWordに移植できないものか、やってみたら……。
「実行時エラー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のブックが表示されてしまう。うっとうしいんだけれど、これをしないと、
こんなふうに、ListCountメソッドが失敗してしまう。
ちなみに、このときに、イミディエイトで
xlApp.Visible = True
としてExcelを表示させてみると、
このようになっていて、フォント選択のコンボボックスは死んでいる……というかまだ生まれていないみたい。
(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の順で表示されるはずだ。
実行結果
見込み通りの結果となった。
おわりに
でも、絶対にWordだけでもできるはずだよなあ……。