【VBA×WindowsAPI】UserFormのタイトルバーにアイコンを設定する

VBAでマクロを作成しているとき、他のアプリケーションと同じようにUserFormウィンドウのタイトルバーにアイコンを付けたいと感じるときが稀にあります。しかしUserFormはタイトルバーの文字列(Caption)を変えることはできても、アイコンを設定するような機能は備わっていません。

このようなVBAの機能だけでは実現できないこともWindows APIを利用することで実現することができます。マクロの機能的には存在しなくても全く問題のないアイコンですが、設定する方法が存在するということを知っておけばデザインをこだわりたいときに非常に役に立つノウハウとなります。

1. UserFormのタイトルバーにアイコンを設定する
2. サンプルコード
3. コード解説
4. 関連情報

UserFormのタイトルバーにアイコンを設定する

Windows APIの関数を使うことで上画像のようにUserFormのタイトルバーにアイコンを設定することができます。アイコンを設定する方法として、既に画面上に存在するウィンドウに設定されているアイコン情報を流用する方法と任意のアイコンファイル(.ico)をアイコンとして設定する方法があります。

VBAでUserFormのタイトルバーにアイコンを設定するには下記のWindows APIを利用します。
それぞれ関数のより詳細な使い方の解説は各関数のリンクページを参照下さい。

FindWindow関数：　　ウィンドウハンドルを取得する
GetClassLongPtr関数：指定ウィンドウのアイコン情報を取得する
SetClassLongPtr関数：指定ウィンドウにアイコン情報を設定する
LoadImage関数：　　　指定画像ファイルをメモリ上に読み込む
DestroyIcon関数：　　アイコン情報を保持したメモリを解放する

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

サンプルコード

下記は現在開かれているアプリケーションのウィンドウを取得して、そのウィンドウに設定されているアイコン情報をそのままUserFormのタイトルバーに設定するためのサンプルコードです。hWndAppにアイコン付きウィンドウのハンドルを渡すことで、UserFormのタイトルバーにそのウィンドウと同じアイコンを設定することができます。サンプルコードではExcelとメモ帳のコードを記載しています。(※メモ帳の場合はコード実行時にメモ帳ウィンドウを起動しておく必要あり)

Option Explicit

Private Declare PtrSafe Function GetClassLongPtr Lib "user32" Alias "GetClassLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetClassLongPtr Lib "user32" Alias "SetClassLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function DestroyIcon Lib "user32" (ByVal hIcon As LongPtr) As Long

Private Const GCL_HICON As Long = -14

Dim hWndForm    As LongPtr
Dim hIcon       As LongPtr

'------------------------------------------------------------------
'   UserForm起動時ｲﾍﾞﾝﾄ
'------------------------------------------------------------------
Private Sub UserForm_Initialize()

    Dim hWndApp As LongPtr
    Dim hCls As LongPtr
    
    'UserFormのﾊﾝﾄﾞﾙを取得
    hWndForm = FindWindow("ThunderDFrame", Me.Caption)
    
    'ｱｲｺﾝ取得対象のｳｨﾝﾄﾞｳﾊﾝﾄﾞﾙを取得
    hWndApp = Application.hWnd  'Excelｱｲｺﾝ
    'hWndApp = FindWindow("notepad", vbNullString) 'ﾒﾓ帳ｱｲｺﾝ

    '指定ｳｨﾝﾄﾞｳのｱｲｺﾝへのﾊﾝﾄﾞﾙを取得
    hIcon = GetClassLongPtr(hWndApp, GCL_HICON)
    
    'UserFormに取得したｱｲｺﾝを設定
    hCls = SetClassLongPtr(hWndForm, GCL_HICON, hIcon)
    
End Sub
'------------------------------------------------------------------
'   UserForm終了時ｲﾍﾞﾝﾄ
'------------------------------------------------------------------
Private Sub UserForm_Terminate()

    hWndForm = FindWindow("ThunderDFrame", Me.Caption)
    Call SetClassLongPtr(hWndForm, GCL_HICON, 0)
    
End Sub

Option Explicit

Private Declare PtrSafe Function GetClassLongPtr Lib "user32" Alias "GetClassLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr

Private Declare PtrSafe Function SetClassLongPtr Lib "user32" Alias "SetClassLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Private Declare PtrSafe Function DestroyIcon Lib "user32" (ByVal hIcon As LongPtr) As Long

Private Const GCL_HICON As Long = -14

Dim hWndForm As LongPtr

Dim hIcon As LongPtr

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

' UserForm起動時ｲﾍﾞﾝﾄ

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

Private Sub UserForm_Initialize()

Dim hWndApp As LongPtr

Dim hCls As LongPtr

'UserFormのﾊﾝﾄﾞﾙを取得

hWndForm = FindWindow("ThunderDFrame", Me.Caption)

'ｱｲｺﾝ取得対象のｳｨﾝﾄﾞｳﾊﾝﾄﾞﾙを取得

hWndApp = Application.hWnd 'Excelｱｲｺﾝ

'hWndApp = FindWindow("notepad", vbNullString) 'ﾒﾓ帳ｱｲｺﾝ

'指定ｳｨﾝﾄﾞｳのｱｲｺﾝへのﾊﾝﾄﾞﾙを取得

hIcon = GetClassLongPtr(hWndApp, GCL_HICON)

'UserFormに取得したｱｲｺﾝを設定

hCls = SetClassLongPtr(hWndForm, GCL_HICON, hIcon)

End Sub

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

' UserForm終了時ｲﾍﾞﾝﾄ

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

Private Sub UserForm_Terminate()

hWndForm = FindWindow("ThunderDFrame", Me.Caption)

Call SetClassLongPtr(hWndForm, GCL_HICON, 0)

End Sub

　
下記はアイコンファイルを読み込んでUserFormのタイトルバーにアイコン設定するためのサンプルコードです。sPathIconに表示させたいアイコンファイルのフルパスを入力することで、その画像をアイコンとして設定することができます。アイコンサイズに決まりはないですサンプルコードでは32×32を想定しています。hIconの取得方法が違うだけで基本的にはもう一方の手法と同じ考えです。

Option Explicit

Private Declare PtrSafe Function SetClassLongPtr Lib "user32" Alias "SetClassLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function DestroyIcon Lib "user32" (ByVal hIcon As LongPtr) As Long
Private Declare PtrSafe Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As LongPtr, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPtr

Private Const GCL_HICON As Long = -14
Private Const IMAGE_ICON As Long = &H1
Private Const LR_LOADFROMFILE As Long = &H10

Dim hWndForm    As LongPtr
Dim hIcon       As LongPtr

'------------------------------------------------------------------
'   UserForm起動時ｲﾍﾞﾝﾄ
'------------------------------------------------------------------
Private Sub UserForm_Initialize()

    Dim sPathIcon As String
    Dim hCls As LongPtr
    
    'UserFormのﾊﾝﾄﾞﾙを取得
    hWndForm = FindWindow("ThunderDFrame", Me.Caption)

    'ｱｲｺﾝﾌｧｲﾙ(.ico)を読み込み
    sPathIcon = "C:\...\icon.ico"
    hIcon = LoadImage(0, sPathIcon, IMAGE_ICON, 32, 32, LR_LOADFROMFILE)

    'UserFormに取得したｱｲｺﾝを設定
    hCls = SetClassLongPtr(hWndForm, GCL_HICON, hIcon)
    
End Sub

'------------------------------------------------------------------
'   UserForm終了時ｲﾍﾞﾝﾄ
'------------------------------------------------------------------
Private Sub UserForm_Terminate()

    hWndForm = FindWindow("ThunderDFrame", Me.Caption)
    Call SetClassLongPtr(hWndForm, GCL_HICON, 0)

    'ｱｲｺﾝ解放
    If hIcon <> 0 Then Call DestroyIcon(hIcon)
    
End Sub

Option Explicit

Private Declare PtrSafe Function SetClassLongPtr Lib "user32" Alias "SetClassLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Private Declare PtrSafe Function DestroyIcon Lib "user32" (ByVal hIcon As LongPtr) As Long

Private Declare PtrSafe Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As LongPtr, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPtr

Private Const GCL_HICON As Long = -14

Private Const IMAGE_ICON As Long = &H1

Private Const LR_LOADFROMFILE As Long = &H10

Dim hWndForm As LongPtr

Dim hIcon As LongPtr

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

' UserForm起動時ｲﾍﾞﾝﾄ

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

Private Sub UserForm_Initialize()

Dim sPathIcon As String

Dim hCls As LongPtr

'UserFormのﾊﾝﾄﾞﾙを取得

hWndForm = FindWindow("ThunderDFrame", Me.Caption)

'ｱｲｺﾝﾌｧｲﾙ(.ico)を読み込み

sPathIcon = "C:\...\icon.ico"

hIcon = LoadImage(0, sPathIcon, IMAGE_ICON, 32, 32, LR_LOADFROMFILE)

'UserFormに取得したｱｲｺﾝを設定

hCls = SetClassLongPtr(hWndForm, GCL_HICON, hIcon)

End Sub

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

' UserForm終了時ｲﾍﾞﾝﾄ

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

Private Sub UserForm_Terminate()

hWndForm = FindWindow("ThunderDFrame", Me.Caption)

Call SetClassLongPtr(hWndForm, GCL_HICON, 0)

'ｱｲｺﾝ解放

If hIcon <> 0 Then Call DestroyIcon(hIcon)

End Sub

コード解説

UserFormのウィンドウハンドルを取得

ウィンドウにはそれぞれウィンドウハンドルと呼ばれる、ウィンドウを識別するためのID情報のようなものが付与されています。このウィンドウハンドルを取得することで、”どの”ウィンドウに対して処理を行うのかを簡単に指示することができます。(Windows APIでは頻出ワードです)

UserFormもウィンドウの1つであるため一意のウィンドウハンドルを持ちます。ウィンドウハンドルを取得するための関数はいくつも存在しますがここでは常套手段のFindWindow関数を使ってウィンドウハンドルを取得しています。FindWindow関数は下記のように記載することで指定のクラス名もしくはウィンドウ名から該当のウィンドウへのハンドルを取得することができます。

FindWindow関数

hWnd = FindWindow(“クラス名”, “ウィンドウ名”)

UserFormはクラス名が”ThunderDFrame”で、ウィンドウ名はMe.Captionとなります。いずれか片方を入力してもう一方の引数をvbNullStringとしても取得可能ですが、サンプルコードではどちらの引数も入力して確実にUserFormが取得できるようにしています。

アイコンへのハンドルを取得 (既存ウィンドウから情報取得)

指定のウィンドウのアイコン情報(アイコンへのハンドル)を取得するにはUserFormと同じように対象のウィンドウのハンドルを取得する必要があります。Excel VBAの場合、ApplicationオブジェクトのhWndプロパティでExcelアプリケーションウィンドウのハンドルを取得することができます。

その他のアプリケーションのウィンドウハンドルを取得するには前項と同じくFindWindow関数やGetActiveWindow関数等を使います。指定のウィンドウのクラス名やウィンドウ名などのウィンドウ情報は専用ツール(Microsoft Spy++等)で調べることができます。

取得したウィンドウハンドルが持つアイコン情報を取得するには、指定のウィンドウの情報を取得するためのGetClassLongPtr関数を使い下記のように記載します。

アイコン情報の取得

hIcon = GetClassLongPtr(hWnd, GCL_HICON)

第1引数の「hWnd」にはアイコン情報を取得する対象のウィンドウハンドル、第2引数には取得する情報がアイコンであることを表す定数値「GCL_HICON」をそれぞれ入力することで、戻り値として入力したウィンドウが持つアイコン情報を取得することができます。
　　

アイコンへのハンドルを取得 (アイコンファイル読み込み)

ローカルにあるアイコンファイルからアイコン情報(アイコンへのハンドル)を取得するには、LoadImage関数を使って指定のアイコンデータをメモリ上に読み込ませる必要があります。

アイコン情報の取得

hIcon = LoadImage(0, sPath, IMAGE_ICON, 32, 32, LR_LOADFROMFILE)

第1引数は今回の場合は使わないので「0」、第2引数の「sPath」には読み込ませるアイコンファイルのフルパス、第3引数には読み込ませる画像がアイコンであることを表す定数値「IMAGE_ICON」、第4と第5引数にはアイコンファイルの幅と高さ(ここでは32×32を想定)、第6引数にはファイルからデータを読み込ませることを表す定数値「LR_LOADFROMFILE」をそれぞれ入力します。

これにより指定のアイコンがメモリ上に読み込まれ、そのアイコンへのハンドルを戻り値として取得することができます。
　　

UserFormに取得したアイコンを設定

アイコンへのハンドルが取得できたら、UserFormにそのアイコンが示すハンドルを設定します。指定のウィンドウの情報を設定するためのSetClassLongPtr関数を使い下記のように記載します。

アイコン情報の設定

hCls = SetClassLongPtr(hWnd, GCL_HICON, hIcon)

第1引数の「hWnd」にはアイコンを設定するUserFormのウィンドウハンドル、第2引数には設定する情報がアイコンであることを表す定数値「GCL_HICON」、第3引数の「hIcon」には設定するアイコンへのハンドルをそれぞれ入力します。戻り値としてアイコン設定前のウィンドウ情報が返ってきますが、サンプルコードのケースでは特に使用しないのでCallで呼び出すだけでも問題はありません。

これによりUserFormに入力したハンドルが示すアイコンが設定されます。
　