VBA调用WinAPI创建Tooltip失败：CreateWindowEx返回NULL

问题现象 #

通过WinAPI在VBA中创建Tooltip时，CreateWindowEx()返回NULL，但调用GetLastError()返回0，在Excel和Outlook环境下测试结果一致，无法确定是功能不可实现还是参数传递错误。

原始代码片段 #

Private Type INITCOMMONCONTROLSEX_REC
  dwSize As Long
  dwICC As Long
End Type

Private Const ICC_WIN95_CLASSES = &HFF

Private Declare PtrSafe Function InitCommonControlsEx Lib "Comctl32.dll" (ByRef icce As INITCOMMONCONTROLSEX_REC) As Long

Private Const WS_EX_TOPMOST As Long = &H8
Private Const WS_POPUP As Long = &H80000000
Private Const TTS_ALWAYSTIP As Long = &H1
Private Const TTS_NOPREFIX As Long = &H2

Private Const TOOLTIPS_CLASS = "tooltips_class32"

Private Declare PtrSafe Function CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" (dwExStyle As Long, lpClassName As String, lpWindowName As String, _
        ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As LongPtr, ByVal hMenu As LongPtr, _
        ByVal hInstance As LongPtr, lpParam As Any) As LongPtr


Public Sub CreateToolTip()
    Dim ret As Long
    Dim retLng As LongPtr
    
    Dim iccRec As INITCOMMONCONTROLSEX_REC
    iccRec.dwSize = LenB(iccRec)
    iccRec.dwICC = ICC_WIN95_CLASSES
    
    ret = InitCommonControlsEx(iccRec)
        
    Dim hWndTip As LongPtr
    hWndTip = CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, vbNullString, _
        WS_POPUP Or TTS_NOPREFIX Or TTS_ALWAYSTIP, _
        0, 0, 0, 0, 0, 0, 0, ByVal 0)

End Sub

问题根源与修复方案 #

1. 通用控件初始化错误 #

ICC_WIN95_CLASSES是兼容旧控件的通配常量，无法确保Tooltip控件类被正确注册。应替换为**ICC_TOOLTIP_CLASSES**（值为&H80），这是专门用于注册Tooltip控件的常量。

2. CreateWindowEx参数传递错误 #

• hInstance参数：必须传递当前Office应用的实例句柄，而非0。在VBA中可通过Application.hInstance获取（Excel/Outlook均支持）。
• lpParam参数：应传递ByVal 0&以确保是Long类型的空指针，避免类型不匹配。
• 扩展样式补充：建议添加WS_EX_TOOLWINDOW（&H80），防止Tooltip窗口出现在任务栏。

3. 缺少Tooltip关联步骤 #

创建Tooltip窗口后，需通过TTM_ADDTOOL消息将其关联到目标控件（如工作表按钮、窗体控件），否则Tooltip不会触发显示。

修改后的完整代码 #

Private Type INITCOMMONCONTROLSEX_REC
    dwSize As Long
    dwICC As Long
End Type

Private Type TOOLINFO
    cbSize As Long
    uFlags As Long
    hwnd As LongPtr
    uId As LongPtr
    rect As RECT
    hinst As LongPtr
    lpszText As String
    lParam As LongPtr
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

' 初始化通用控件常量
Private Const ICC_TOOLTIP_CLASSES = &H80

' 窗口样式常量
Private Const WS_EX_TOPMOST = &H8
Private Const WS_EX_TOOLWINDOW = &H80
Private Const WS_POPUP = &H80000000
Private Const TTS_ALWAYSTIP = &H1
Private Const TTS_NOPREFIX = &H2

' Tooltip消息常量
Private Const TTM_ADDTOOL = &H400 + 50
Private Const TTF_SUBCLASS = &H10

Private Const TOOLTIPS_CLASS = "tooltips_class32"

' API声明
Private Declare PtrSafe Function InitCommonControlsEx Lib "Comctl32.dll" (ByRef icce As INITCOMMONCONTROLSEX_REC) As Long
Private Declare PtrSafe Function CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" ( _
    ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, _
    ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
    ByVal hWndParent As LongPtr, ByVal hMenu As LongPtr, ByVal hInstance As LongPtr, lpParam As Any) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
    ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPtr
Private Declare PtrSafe Function GetClientRect Lib "user32.dll" (ByVal hwnd As LongPtr, ByRef lpRect As RECT) As Long

Public Sub CreateAndAttachToolTip()
    Dim iccRec As INITCOMMONCONTROLSEX_REC
    iccRec.dwSize = LenB(iccRec)
    iccRec.dwICC = ICC_TOOLTIP_CLASSES
    
    ' 初始化Tooltip控件类
    If InitCommonControlsEx(iccRec) = 0 Then
        MsgBox "通用控件初始化失败"
        Exit Sub
    End If
    
    ' 创建Tooltip窗口
    Dim hWndTip As LongPtr
    hWndTip = CreateWindowEx( _
        WS_EX_TOPMOST Or WS_EX_TOOLWINDOW, _
        TOOLTIPS_CLASS, vbNullString, _
        WS_POPUP Or TTS_NOPREFIX Or TTS_ALWAYSTIP, _
        0, 0, 0, 0, _
        0, 0, Application.hInstance, ByVal 0&)
    
    If hWndTip = 0 Then
        MsgBox "Tooltip窗口创建失败"
        Exit Sub
    End If
    
    ' 准备关联到目标控件（示例：Excel中的CommandButton1）
    Dim targetHwnd As LongPtr
    targetHwnd = Sheet1.CommandButton1.hwnd ' 替换为你的目标控件句柄
    
    Dim ti As TOOLINFO
    ti.cbSize = LenB(ti)
    ti.uFlags = TTF_SUBCLASS
    ti.hwnd = targetHwnd
    ti.hinst = Application.hInstance
    ti.lpszText = "这是自定义Tooltip内容"
    
    ' 获取目标控件的客户区矩形
    GetClientRect targetHwnd, ti.rect
    
    ' 将Tooltip关联到目标控件
    SendMessage hWndTip, TTM_ADDTOOL, 0, ti
End Sub

说明 #

• 替换代码中的Sheet1.CommandButton1.hwnd为实际需要添加Tooltip的控件句柄。
• 若使用Outlook，需获取对应窗体控件的句柄（如Inspector窗口中的控件）。
• 确保Office为32位或64位时，PtrSafe声明正确适配（代码已兼容64位Office）。

内容的提问来源于stack exchange，提问作者Brogon