使用VBA添加ImageCombo-ActiveX控件至Excel工作表的显示异常问题

当通过OLEObjects.Add添加MSComctlLib.ImageComboCtl.2控件后，控件会被加载到Excel的隐藏CtlFrameworkParking窗口下，无法直接正常显示。可以通过Windows API调用强制将控件绑定到工作表窗口并触发正常渲染，无需手动操作。

实现步骤 #

1. 声明Windows API函数（模块顶部） #

在VBA模块的最上方添加以下API声明（64位Excel保留PtrSafe和LongPtr，32位Excel去掉PtrSafe并将LongPtr替换为Long）：

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function SetParent Lib "user32" (ByVal hWndChild As LongPtr, ByVal hWndNewParent As LongPtr) As LongPtr
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr

Private Const SW_SHOW = 5
Private Const WM_SETREDRAW = &HB

2. 编写修复显示的核心函数 #

这个函数负责定位控件句柄、修改父窗口并触发正常渲染：

Sub FixImageComboDisplay(ctrl As OLEObject, ws As Worksheet)
    Dim hWndParking As LongPtr
    Dim hWndCombo As LongPtr
    Dim hWndSheet As LongPtr
    
    ' 逐层获取工作表窗口的句柄
    hWndSheet = FindWindow("XLMAIN", Application.Caption)
    hWndSheet = FindWindowEx(hWndSheet, 0, "XLDESK", vbNullString)
    hWndSheet = FindWindowEx(hWndSheet, 0, "EXCEL7", ws.Name)
    
    ' 获取隐藏的CtlFrameworkParking窗口句柄
    hWndParking = FindWindow("CtlFrameworkParking", vbNullString)
    
    ' 在Parking窗口下定位ImageCombo控件的句柄
    hWndCombo = FindWindowEx(hWndParking, 0, "MSComctlLib.ImageComboCtl.2", vbNullString)
    
    If hWndCombo <> 0 And hWndSheet <> 0 Then
        ' 禁用工作表重绘，避免闪烁
        SendMessage hWndSheet, WM_SETREDRAW, 0, 0
        
        ' 将控件的父窗口从Parking改为工作表窗口
        SetParent hWndCombo, hWndSheet
        
        ' 设置控件实际显示尺寸（替换为你的目标高度和宽度）
        ctrl.Height = 22
        ctrl.Width = 160
        
        ' 强制显示控件
        ShowWindow hWndCombo, SW_SHOW
        
        ' 恢复重绘并刷新工作表
        SendMessage hWndSheet, WM_SETREDRAW, 1, 0
        ws.Activate
        Application.ScreenUpdating = True
    End If
End Sub

3. 调用示例（添加控件并修复显示） #

将原来的控件添加代码和修复函数结合：

Sub AddImageCombo()
    Dim TopPos As Double, LeftPos As Double
    Dim imgCombo As OLEObject
    
    ' 设置控件的初始位置
    TopPos = 60
    LeftPos = 60
    
    ' 添加初始尺寸为0的ImageCombo控件
    Set imgCombo = ActiveSheet.OLEObjects.Add(ClassType:="MSComctlLib.ImageComboCtl.2", _
        Top:=TopPos, Left:=LeftPos, Height:=0, Width:=0)
    
    ' 立即调用修复函数，让控件正常显示
    FixImageComboDisplay imgCombo, ActiveSheet
End Sub

注意事项 #

• 如果工作表中有多个ImageCombo控件，可通过控件名称（imgCombo.Name）作为FindWindowEx的窗口名称参数，精准定位目标控件
• 确保Excel已启用对MSComctlLib控件的引用（VBE工具→引用→勾选"Microsoft Windows Common Controls 6.0 (SP6)"）
• 不同Excel版本的窗口类名可能略有差异，若FindWindowEx返回0，可通过Winspector Spy重新确认窗口类名

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