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

CreatePopupMenu関数

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

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

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

使用方法

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

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

 icon-code  64bit  

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

icon-code  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

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

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

 

構文

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

icon-code 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

 

 icon-share-square  VBA×WindowsAPIまとめページ

その他のWindowsAPI関数は下記ページにまとまっているので合わせて参照下さい。

 icon-share-square  参考

Microsoft公式:CreatePopupMenu 関数 (winuser.h) – Win32 apps

Excel,VBA,Windows API