Option Explicit
' API Deklarationen
Private Declare Function GetMenu Lib "user32" _
    (ByVal hwnd As Long) As Long
 
Private Declare Function GetSubMenu Lib "user32" _
    (ByVal hMenu As Long, ByVal nPos As Long) As Long
 
Private Declare Function GetMenuItemID Lib "user32" _
    (ByVal hMenu As Long, ByVal nPos As Long) As Long
 
Private Declare Function ModifyMenu Lib "user32" Alias "ModifyMenuA" _
    (ByVal hMenu As Long, ByVal nPosition _
     As Long, ByVal wFlags As Long, ByVal wIDNewItem As _
     Long, ByVal lpString As Any) As Long
 
' API Konstanten
Const MF_BYCOMMAND = &H0&
Const MF_BITMAP = &H4&
 
Private Sub Form_Load()
  '--------------------------------------------------
  Dim i             As Long
  Dim hMenu         As Long     ' Handle des Form Menüs
  Dim hSubMenu      As Long     ' Handle betreffenden "SubMenüs"
  Dim lMenuItemID   As Long     ' Das jeweilige Menü Items
  Dim lFont         As Long     ' Laufende Nummer der Schriftart
  Dim lHeightMax    As Long     ' Maximale Höhe
  Dim lWidthMax     As Long     ' Maximale Breite
  Dim sMenuText     As String   ' Der jeweilige Menütext
  '--------------------------------------------------
  On Error GoTo Error_
  lFont = -2
  For i = 0 To Screen.FontCount
    If Screen.Fonts(i) = "Verdana" Then
      lFont = i
      Exit For
    End If
  Next i
  If lFont = -1 Then lFont = 1  ' Sicher ist sicher
  '--------------------------------------------------
  hMenu = GetMenu(Me.hwnd)
  hSubMenu = GetSubMenu(hMenu, 1)
  '--------------------------------------------------
  For i = 1 To 3
    sMenuText = CStr("SubMenü Test " & i)
    Load picMenu(picMenu.Count)
    With picMenu(picMenu.Count - 1)
      .Font.Name = lFont
      .Font.Size = 12
      ' Höhe
      .Height = .TextHeight(sMenuText)
      If .Height > lHeightMax Then lHeightMax = .Height
      ' Breite
      .Width = .TextWidth(sMenuText)
      If .Width > lWidthMax Then lWidthMax = .Width
      ' Text des Menüeintrages in die Picture Box
      picMenu(picMenu.Count - 1).Print sMenuText
      .Picture = .Image
      ' Picture in das Menü setzten
      lMenuItemID = GetMenuItemID(hSubMenu, i - 1)
      Call ModifyMenu(hSubMenu, lMenuItemID, MF_BYCOMMAND Or MF_BITMAP, _
                      lMenuItemID, CLng(.Picture))
      ' und schon ist der Dekel auf dem Topf
    End With
  Next i
  '--------------------------------------------------
  Exit Sub
Error_:
  '...
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
  Dim i         As Long
  For i = 1 To 3
    Unload picMenu(i)
  Next i
End Sub
 
Private Sub mnuTest1_Click()
  Debug.Print "mnuTest1"
End Sub
 
Private Sub mnuTest2_Click()
  Debug.Print "mnuTest2"
End Sub
 
Private Sub mnuTest3_Click()
  Debug.Print "mnuTest3"
End Sub