【VBA×WindowsAPI】使用可能なフォント名をすべて列挙する

VBAでWindowsAPIを使っているとフォントを指定する場面に出くわすことがあります。そういった場合にフォント名を取得する必要が出てきますが、これもWindowsAPIで取得することができます。

フォントはグラフィックスデバイスインターフェイス(GDI)の一種でWindowsAPIではウィンドウに図形を描画する論理ペンや論理ブラシと同様のものとして扱われることが一般的です。

1. 使用可能なフォント名をすべて列挙する
2. サンプルコード
3. コード解説
4. 関連情報

使用可能なフォント名をすべて列挙する

システム内にインストールされているフォントの名称はWindowsAPIのEnumFontFamiliesEx関数という関数で一括で取得することができます。この関数は引数に”関数”を入力する少し特殊な関数で、VBAで使用する場合はAddresOf演算子を使ってFunctionプロシージャを入力します。このような引数に関数を入力する関数をコールバック関数と呼び、EnumFontFamiliesEx関数に入力するコールバック関数はEnumFontFamExProcという名称を付けるのが一般的です。(VBAの場合は特に決まりなし)

VBAで使用可能なフォント名をすべて列挙するには下記のWindows APIを利用します。
それぞれ関数のより詳細な使い方の解説は各関数のリンクページを参照下さい。

EnumFontFamiliesEx関数　：システム内のフォントを列挙する
GetDC関数 　　　　　　：デバイスコンテキスト(DC)を取得する
ReleaseDC関数 　　　　　：指定のDCを解放する

「そもそもWindows APIって何？」という方はコチラ(メインページ)も併せて参照下さい。

サンプルコード

システム内にインストールされているフォント名をイミディエイトウィンドウに列挙するサンプルコードは下記の通りです。出力と合わせてコレクションに文字列としてすべて格納もしています。

Option Explicit
Declare PtrSafe Function EnumFontFamiliesEx Lib "gdi32" Alias "EnumFontFamiliesExA" (ByVal hDc As LongPtr, lpLogFont As LOGFONT, ByVal lpEnumFontProc As LongPtr, ByVal lParam As LongPtr, ByVal dw As Long) As Long
Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDc As LongPtr) As Long
 
Const LF_FACESIZE = 32
Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName(1 To LF_FACESIZE) As Byte
End Type
        
Const ANSI_CHARSET = 0          'ANSI文字ｾｯﾄ
Const DEFAULT_CHARSET = 1       'ﾃﾞﾌｫﾙﾄ文字ｾｯﾄ
Const SHIFTJIS_CHARSET = 128    'Shift-JIS文字ｾｯﾄ

Dim cFontNames As Collection    'ﾌｫﾝﾄ名格納用ｺﾚｸｼｮﾝ
'------------------------------------------------------------
'   ﾒｲﾝ処理
'------------------------------------------------------------
Sub main()

    Dim hDc As LongPtr
    Dim lpLogFont As LOGFONT
    
    Set cFontNames = New Collection
    
    '取得文字ｾｯﾄの設定
    lpLogFont.lfCharSet = ANSI_CHARSET
    
    'DC取得
    hDc = GetDC(0)

    'ﾌｫﾝﾄ名取得
    Call EnumFontFamiliesEx(hDc, lpLogFont, AddressOf EnumFontFamExProc, 0, 0)
    
    'DC解放
    Call ReleaseDC(0, hDc)
    
End Sub
'------------------------------------------------------------
'   ｺｰﾙﾊﾞｯｸ関数
'------------------------------------------------------------
Function EnumFontFamExProc(ByRef lpelfe As LOGFONT, _
                           ByVal lpntme As LongPtr, _
                           ByVal FontType As LongPtr, _
                           ByVal lParam As LongPtr) As Long

    Dim sFontName As String
    
    'Unicode変換
    sFontName = StrConv(lpelfe.lfFaceName, vbUnicode)
    
    'ﾃﾞｰﾀ不要部の削除
    If InStr(sFontName, vbNullChar) Then
        sFontName = Left(sFontName, InStr(sFontName, vbNullChar) - 1)
    End If
    
    'ｺﾚｸｼｮﾝに保持
    cFontNames.Add sFontName
    Debug.Print sFontName
    
    EnumFontFamExProc = 1
    
End Function

Option Explicit

Declare PtrSafe Function EnumFontFamiliesEx Lib "gdi32" Alias "EnumFontFamiliesExA" (ByVal hDc As LongPtr, lpLogFont As LOGFONT, ByVal lpEnumFontProc As LongPtr, ByVal lParam As LongPtr, ByVal dw As Long) As Long

Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr

Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDc As LongPtr) As Long

Const LF_FACESIZE = 32

Type LOGFONT

lfHeight As Long

lfWidth As Long

lfEscapement As Long

lfOrientation As Long

lfWeight As Long

lfItalic As Byte

lfUnderline As Byte

lfStrikeOut As Byte

lfCharSet As Byte

lfOutPrecision As Byte

lfClipPrecision As Byte

lfQuality As Byte

lfPitchAndFamily As Byte

lfFaceName(1 To LF_FACESIZE) As Byte

End Type

Const ANSI_CHARSET = 0 'ANSI文字ｾｯﾄ

Const DEFAULT_CHARSET = 1 'ﾃﾞﾌｫﾙﾄ文字ｾｯﾄ

Const SHIFTJIS_CHARSET = 128 'Shift-JIS文字ｾｯﾄ

Dim cFontNames As Collection 'ﾌｫﾝﾄ名格納用ｺﾚｸｼｮﾝ

'------------------------------------------------------------

' ﾒｲﾝ処理

'------------------------------------------------------------

Sub main()

Dim hDc As LongPtr

Dim lpLogFont As LOGFONT

Set cFontNames = New Collection

'取得文字ｾｯﾄの設定

lpLogFont.lfCharSet = ANSI_CHARSET

'DC取得

hDc = GetDC(0)

'ﾌｫﾝﾄ名取得

Call EnumFontFamiliesEx(hDc, lpLogFont, AddressOf EnumFontFamExProc, 0, 0)

'DC解放

Call ReleaseDC(0, hDc)

End Sub

'------------------------------------------------------------

' ｺｰﾙﾊﾞｯｸ関数

'------------------------------------------------------------

Function EnumFontFamExProc(ByRef lpelfe As LOGFONT, _

ByVal lpntme As LongPtr, _

ByVal FontType As LongPtr, _

ByVal lParam As LongPtr) As Long

Dim sFontName As String

'Unicode変換

sFontName = StrConv(lpelfe.lfFaceName, vbUnicode)

'ﾃﾞｰﾀ不要部の削除

If InStr(sFontName, vbNullChar) Then

sFontName = Left(sFontName, InStr(sFontName, vbNullChar) - 1)

End If

'ｺﾚｸｼｮﾝに保持

cFontNames.Add sFontName

Debug.Print sFontName

EnumFontFamExProc = 1

End Function

コード解説

DCを取得/解放する

ウィンドウには描画関係の処理を行うためのデバイスコンテキスト(DC)というものが存在します。
このDCを介すことで、ウィンドウ内のピクセル情報を取得したり、図形の描画を行ったりすることが可能になります。DCを取得するにはまず対象のウィンドウのンドルを取得する必要があります。これはウィンドウを識別するためのID情報のようなもので、ハンドルを取得すれば”どの”ウィンドウに対して処理を行うのかを簡単に指示することができます。(Windows APIでは頻出ワードです)

EnumFontFamiliesEx関数では適当なDCを用意しておけばよいので、GetDC関数の引数を「0」で実行して画面全体のDCを取得します。ここで取得したDCは最終的にReleaseDC関数で解放する必要があるので注意が必要です。ReleaseDC関数もGetDC関数と同じく第1引数には「0」を入力し、第2引数には解放するDCを入力します。

GetDC関数

hDc = GetDC(0)

RelaseDC関数

Call ReleaseDC(0, hDc)

下記のフォント名取得後はどのタイミングで開放しても問題ありません。
　

フォント名の取得

フォント名を列挙するにはEnumFontFamiliesEx関数を使って下記のように記載します。

EnumFontFamiliesEx関数

Call EnumFontFamiliesEx(hDc, lpLogFont, AddressOf EnumFontFamExProc, 0, 0)

第1引数の「hWnd」には取得したDCを入力します。
第2引数の「lpLogFont」には文字セットを指定したLOGFONT構造体を入力します。構造体の「lfCharSet」の値を変更することで文字セットを指定することができ、取得するフォントが変化します。サンプルコードでは定数値としてANSIとShift-JIS、デフォルトの3種を用意していますがその他の文字セットも指定することが可能です。

第3引数にはコールバック関数として別途定義しているFunctionプロシージャのEnumFontFamExProc関数をAddresOf演算子とあわせて入力します。これにより、取得可能なフォントの数だけEnumFontFamExProc関数が繰り返し実行され、実行毎に取得できるフォントが順繰りに変化していきます。フォント名はEnumFontFamExProc関数の第1引数の「lpelfe」というLOGFONT構造体の「lfFaceName」内に格納されます。このときlfFaceName内の値はそのまま取得すると文字化けするのでStrConv関数でUnicodeに変換する必要があります。

第4,5引数は特に指定する必要が無いもののため「0」を入力して完了です。