【VBA×WindowsAPI】CreatePopupMenu関数の使い方

1. CreatePopupMenu関数

CreatePopupMenu関数

CreatePopupMenu関数はドロップダウンメニュー、サブメニュー、コンテキストメニュー(ショートカットメニュー)を作成するための関数です。この関数で作成されるメニューは”空の状態”であるため、AppendMenu関数やInsertMenu関数などのメニュー項目を追加する関数を使ってメニューを1から作成する必要があります。このとき上画像の通り、文字列の設定だけではなくアイコン設定やサブメニューを設定することができます。

作成されたメニューはメモリ上に作成されており画面上には表示されません。画面上に表示させるにはTrackPopupMenu関数やTrackPopupMenuEx関数などを使って表示させる必要があります。

CreatePopupMenu関数で作成されたメニューは不要になった場合、DestroyMenu関数を使ってメモリ上から削除(解放)することができます。このとき、メニューをウィンドウに紐づけている場合は自動的に解放されるため必ずしもDestroyMenu関数が必要になるわけではありません。

使用方法

CreatePopupMenu関数を使用するにはあらかじめ関数の宣言しておく必要があります。
※宣言をしないと関数は使えずにエラーとなるので書き忘れに注意しましょう。

使用しているWindowsが32bitか64bitかによって宣言時に書く文言が違います。
環境に合わせて以下のいずれかをコードの一番初め(Option Explicitの次の行あたり)に書いておくことで、そのモジュール内で各関数を使うことができるようになります。

64bit

Declare PtrSafe Function CreatePopupMenu Lib “user32” () As LongPtr

32bit

Declare Function CreatePopupMenu Lib “user32” () As Long

上記のどちらを書けばいいかわからない場合は以下のコードをコピペして、モジュールの最上部に書いておきましょう。この構文を書いておくことで自動的に使うことのできる方の構文が使用されます。
VBE上では使えない方の構文が赤色で表示される場合がありますが、実行に影響はありません。

#If VBA7 Then
    Declare PtrSafe Function CreatePopupMenu Lib "user32" () As LongPtr
#Else
    Declare Function CreatePopupMenu Lib "user32" () As Long
#End If

#If VBA7 Then

Declare PtrSafe Function CreatePopupMenu Lib "user32" () As LongPtr

#Else

Declare Function CreatePopupMenu Lib "user32" () As Long

#End If

　
各関数の宣言文は「Private/Public」を付けて各関数の有効範囲を指定することもできます。

・Private Declare PtrSafe Function～ ：モジュール内でのみ呼び出し有効
・Public Declare PtrSafe Function～　：モジュール外で呼び出し有効

構文

CreatePopupMenu関数の構文は下記のように書きます。

CreatePopupMenu関数

hMenu = CreatePopupMenu()

戻り値

hMenu (64bit:LongPtr型 / 32bit:Long型)

戻り値はメモリ上に新規作成されたポップアップメニューへのハンドルです。
関数が失敗した場合はNULL(0)が返されます。

サンプルコード

以下はCreatePopupMenu関数とFindWindow関数、DestroyMenu関数、AppendMenu関数、GetCursorPos関数、TrackPopupMenu関数を使って、UserForm上で右クリックをしたらコンテキストメニューを表示するサンプルコードです。

下記コードをUserFormのコードにコピーペーストしてからUserFormを表示すれば、Initializeイベントでメニューがメモリ上に作成され、右クリックをするとそのメニューを表示することができます。

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function CreatePopupMenu Lib "user32" () As LongPtr
Private Declare PtrSafe Function DestroyMenu Lib "user32" (ByVal hMenu As LongPtr) As Long
Private Declare PtrSafe Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As LongPtr, ByVal wFlags As Long, ByVal wIDNewItem As LongPtr, ByVal lpNewItem As Any) As Long
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function TrackPopupMenu Lib "user32" (ByVal hMenu As LongPtr, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hwnd As LongPtr, lprc As Long) As Long

Private Const MF_STRING     As Long = &H0   '文字列設定ﾌﾗｸﾞ
Private Const TPM_RETURNCMD As Long = &H100 '戻り値を選択された項目のIDとする

'ｶｰｿﾙ座標取得用構造体
Private Type POINTAPI
    X As Long
    Y As Long
End Type

Dim hWndForm    As LongPtr  'UserFormｳｨﾝﾄﾞｳﾊﾝﾄﾞﾙ
Dim hMenu       As LongPtr  'ﾎﾟｯﾌﾟｱｯﾌﾟﾒﾆｭｰﾊﾝﾄﾞﾙ

'------------------------------------------------------------------
'   UserForm起動時ｲﾍﾞﾝﾄ
'------------------------------------------------------------------
Private Sub UserForm_Initialize()
    
    'UserFormｳｨﾝﾄﾞｳﾊﾝﾄﾞﾙ取得
    hWndForm = FindWindow("ThunderDFrame", Me.Caption)

    'ﾎﾟｯﾌﾟｱｯﾌﾟﾒﾆｭｰ作成
    hMenu = CreatePopupMenu()
    
    'ﾒﾆｭｰ項目に文字列追加
    Call AppendMenu(hMenu, MF_STRING, 1, "文字列設定1")
    Call AppendMenu(hMenu, MF_STRING, 2, "文字列設定2")
    Call AppendMenu(hMenu, MF_STRING, 3, "文字列設定3")
  
End Sub
'------------------------------------------------------------------
'   UserForm終了時ｲﾍﾞﾝﾄ
'------------------------------------------------------------------
Private Sub UserForm_Terminate()
    
    'ﾎﾟｯﾌﾟｱｯﾌﾟﾒﾆｭｰ解放
    Call DestroyMenu(hMenu)
    
End Sub

'------------------------------------------------------------------
'   UserFormﾏｳｽｱｯﾌﾟｲﾍﾞﾝﾄ
'------------------------------------------------------------------
Private Sub UserForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 
    '右ｸﾘｯｸ時
    If Button = 2 Then

        Dim tPos As POINTAPI
        Dim lRet As Long

        '現在のｶｰｿﾙ位置の座標取得
        Call GetCursorPos(tPos)

        'ｶｰｿﾙ位置にﾎﾟｯﾌﾟｱｯﾌﾟﾒﾆｭｰを表示
        lRet = TrackPopupMenu(hMenu, TPM_RETURNCMD, tPos.X, tPos.Y, 0, hWndForm, 0)
        If lRet <> 0 Then
            Call MsgBox("「ID：" & lRet & "」の項目が選択されました", vbInformation)
        End If

    End If

End Sub

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

Private Declare PtrSafe Function CreatePopupMenu Lib "user32" () As LongPtr

Private Declare PtrSafe Function DestroyMenu Lib "user32" (ByVal hMenu As LongPtr) As Long

Private Declare PtrSafe Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As LongPtr, ByVal wFlags As Long, ByVal wIDNewItem As LongPtr, ByVal lpNewItem As Any) As Long

Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Declare PtrSafe Function TrackPopupMenu Lib "user32" (ByVal hMenu As LongPtr, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hwnd As LongPtr, lprc As Long) As Long

Private Const MF_STRING As Long = &H0 '文字列設定ﾌﾗｸﾞ

Private Const TPM_RETURNCMD As Long = &H100 '戻り値を選択された項目のIDとする

'ｶｰｿﾙ座標取得用構造体

Private Type POINTAPI

X As Long

Y As Long

End Type

Dim hWndForm As LongPtr 'UserFormｳｨﾝﾄﾞｳﾊﾝﾄﾞﾙ

Dim hMenu As LongPtr 'ﾎﾟｯﾌﾟｱｯﾌﾟﾒﾆｭｰﾊﾝﾄﾞﾙ

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

' UserForm起動時ｲﾍﾞﾝﾄ

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