Code:
Option Explicit

' ==================================================
' API DECLARATIONS
' ==================================================
Private Type RECT
    Left As Long: Top As Long: Right As Long: Bottom As Long
End Type

Private Type MENUITEMINFO
    cbSize As Long
    fMask As Long
    fType As Long
    fState As Long
    wID As Long
    hSubMenu As Long
    hbmpChecked As Long
    hbmpUnchecked As Long
    dwItemData As Long
    dwTypeData As Long
    cch As Long
    hbmpItem As Long
End Type

' User32
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 SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" (ByVal hMenu As Long, ByVal uItem As Long, ByVal fByPosition As Long, lpmii As MENUITEMINFO) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function GetSysColorBrush Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAni As Long, ByVal hbrFlickerFree As Long, ByVal diFlags As Long) As Long

' Gdi32
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
' API para extrair o ícone da ImageList
Private Declare Function ImageList_GetIcon Lib "comctl32.dll" ( _
    ByVal himl As Long, _
    ByVal i As Long, _
    ByVal flags As Long) As Long
' Adiciona esta declaração importante
Private Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Const IMAGE_BITMAP As Long = 0
Private Const LR_COPYRETURNORG As Long = &H4

' Constants
Private Const MIIM_BITMAP As Long = &H80
Private Const COLOR_MENU As Long = 4
Private Const DI_NORMAL As Long = &H3
Private Const ILD_TRANSPARENT As Long = &H1

' ==================================================
' MAIN FUNCTION
' ==================================================
Public Sub DrawMenuImage(ByVal hwndWindow As Long, ByVal MenuHeaderPos As Long, ByVal SubMenuPos As Long, ByVal pic As StdPicture)
    Dim hMenu As Long, hSubMenu As Long, hBmp As Long
    Dim mii As MENUITEMINFO

    hMenu = GetMenu(hwndWindow)
    If hMenu = 0 Then Exit Sub

    hSubMenu = GetSubMenu(hMenu, MenuHeaderPos)
    If hSubMenu = 0 Then Exit Sub

    If pic Is Nothing Then Exit Sub

    hBmp = PictureToBitmap32(pic)
    If hBmp = 0 Then Exit Sub

    ' Configurar a estrutura para o SetMenuItemInfo
    mii.cbSize = Len(mii)
    mii.fMask = MIIM_BITMAP
    mii.hbmpItem = hBmp

    ' Aplicar ao item do menu usando o novo método
    If SetMenuItemInfo(hSubMenu, SubMenuPos, True, mii) = 0 Then
        MsgBox "SetMenuItemInfo falhou", vbExclamation
    End If
End Sub

' ==================================================
' CONVERT StdPicture -> 32x32 HBITMAP
' ==================================================
' Altera apenas a função PictureToBitmap32 para incluir a máscara
Private Function PictureToBitmap32(ByVal pic As StdPicture, _
    Optional imgWidth As Long = 16, _
    Optional imgHeight As Long = 16) As Long
    
    Dim hdcScreen As Long, hdcMem As Long
    Dim hOld As Long, hBmp As Long
    Dim r As RECT

    hdcScreen = GetDC(0)
    hdcMem = CreateCompatibleDC(hdcScreen)
    hBmp = CreateCompatibleBitmap(hdcScreen, imgWidth, imgHeight)
    hOld = SelectObject(hdcMem, hBmp)

    ' Fundo COLOR_MENU — única "transparência" possível sem owner draw
    r.Right = imgWidth: r.Bottom = imgHeight
    FillRect hdcMem, r, GetSysColorBrush(COLOR_MENU)

    If pic.Type = vbPicTypeIcon Then
        ' DI_NORMAL sobre COLOR_MENU compõe o alpha do ícone 32bpp
        ' É o máximo possível sem owner draw
        DrawIconEx hdcMem, 0, 0, pic.handle, _
                   imgWidth, imgHeight, 0, 0, DI_NORMAL
    End If

    SelectObject hdcMem, hOld
    DeleteDC hdcMem
    ReleaseDC 0, hdcScreen

    PictureToBitmap32 = hBmp
End Function

Private Function CreateCompatibleBitmapForMenu(ByVal hIcon As Long) As Long
    Dim hdcScreen As Long, hdcMem As Long, hBmp As Long, hOld As Long
    
    hdcScreen = GetDC(0)
    hdcMem = CreateCompatibleDC(hdcScreen)
    
    hBmp = CreateCompatibleBitmap(hdcScreen, 16, 16)
    hOld = SelectObject(hdcMem, hBmp)
    
    ' ALTERAÇÃO: Pintar com MAGENTA (A cor mágica da transparência clássica)
    ' Muitos componentes de menu interpretam o Magenta como "transparente"
    Dim hBrush As Long
    hBrush = CreateSolidBrush(&HFF00FF)
    Dim r As RECT
    r.Right = 16: r.Bottom = 16
    FillRect hdcMem, r, hBrush
    DeleteObject hBrush
    
    ' Desenha o ícone
    DrawIconEx hdcMem, 0, 0, hIcon, 16, 16, 0, 0, DI_NORMAL
    
    SelectObject hdcMem, hOld
    DeleteDC hdcMem
    ReleaseDC 0, hdcScreen
    
    CreateCompatibleBitmapForMenu = hBmp
End Function

' Adiciona esta API para libertar o ícone da memória depois de usado
Public Sub DrawMenuImageFromList(ByVal hwndWindow As Long, ByVal MenuHeaderPos As Long, ByVal SubMenuPos As Long, ByVal imgList As Object, ByVal imgIndex As Long)
    Dim hMenu As Long, hSubMenu As Long, hIcon As Long, hBmp As Long
    Dim mii As MENUITEMINFO

    hMenu = GetMenu(hwndWindow)
    hSubMenu = GetSubMenu(hMenu, MenuHeaderPos)
    
    ' 1. Extrair o ícone
    hIcon = ImageList_GetIcon(imgList.hImageList, imgIndex, ILD_TRANSPARENT)
    
    If hIcon <> 0 Then
        ' 2. Criar o bitmap compatível (DIB)
        hBmp = CreateCompatibleBitmapForMenu(hIcon)
        
        ' 3. Configurar o Menu
        mii.cbSize = Len(mii)
        mii.fMask = MIIM_BITMAP
        mii.hbmpItem = hBmp
        
        SetMenuItemInfo hSubMenu, SubMenuPos, True, mii
        
        ' 4. Limpeza
        DestroyIcon hIcon
    End If
End Sub
can i show the bitmap menu transparent?