如何实现ActiveX ComboBox赋值后显示双列内容？

当为双列结构的ActiveX ComboBox控件的.Value属性赋值其.List中.BoundColumn列已存在的值时，控件的.ListIndex会被自动设置。但目前运行时通过代码给.Value赋值后，控件仅显示被赋值的列，需实现赋值后同时显示两列内容。

实际场景：用户点击单元格后，该ActiveX控件显示，并将点击单元格的值赋值给控件的.Value属性，需修改代码让控件同时展示两列内容。

1. 标准代码模块 #

需补充缺失的常量定义，并新增返回双列数组的CbxAgentList函数：

' 标准代码模块 ==============================
Option Explicit

' 定义全局常量
Public Const nbxAgent As Single = 177 ' 控件总宽度（对应两列宽度之和：33+144）
Public Const CbxAgtName As String = "CbxAgent"

Public CbxAgent             As OLEObject

Sub SetCbxAgent(ws As Worksheet)
    ' FRM 029 ++ 09 Jun 2025
    
    Dim Lst             As Variant
    
    On Error Resume Next
    ws.OLEObjects(CbxAgtName).Delete
    On Error GoTo 0

    Set CbxAgent = ws.OLEObjects.Add(ClassType:="Forms.ComboBox.1", _
                                     Link:=False, _
                                     DisplayAsIcon:=False, _
                                     Left:=200, Top:=70, _
                                     Width:=nbxAgent, Height:=19.5)
    Lst = CbxAgentList
    With CbxAgent
        .Name = CbxAgtName
        With .Object
            .Font.Name = "Calibri"
            .Font.Size = 11
            .ColumnCount = UBound(Lst, 2) + 1
            .List = Lst
            .BoundColumn = 1
            .MatchRequired = True
            .ColumnWidths = CbxAgentColumnWidths
            .Style = fmStyleDropDownList ' 核心设置：改为下拉列表样式，确保显示所有列
        End With
        .Visible = False
    End With
End Sub

Function CbxAgentColumnWidths() As String
    ' FRM 029 ++ 09 Jun 2025
    
    Const codeWidth     As Single = 33
    Const nameWidth     As Single = 144
    
    Dim fun(0 To 1)     As String
    Dim arr             As Variant
    Dim i               As Long
    
    arr = Array(codeWidth, nameWidth)
    For i = 0 To 1
        fun(i) = arr(i) & " pt"
    Next i
    CbxAgentColumnWidths = Join(fun, ";")
End Function

Sub MoveSelectionOnExit(ByVal moveDir As XlDirection)
    ' FRM 029 ++ 01 Jun 2025
    ' 接受参数：xlToRight, xlDown, xlUp, xlToLeft 或 xlNone

    With Application
        .MoveAfterReturn = (moveDir <> xlNone)
        If .MoveAfterReturn Then
            .MoveAfterReturnDirection = moveDir
        End If
    End With
End Sub

' 返回双列Variant类型数组的函数
Function CbxAgentList() As Variant
    ' 示例数据：第一列为代码，第二列为名称
    Dim arr(1 To 2, 1 To 2) As Variant
    
    arr(1, 1) = "CPT"
    arr(1, 2) = "ChatGPT"
    arr(2, 1) = "GPT"
    arr(2, 2) = "GPT-4"
    
    CbxAgentList = arr
End Function

2. 工作表代码模块 #

' 工作表代码模块 =============================
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' FRM 029 ++ 09 Jun 2025

    ClearCbxAgent
    With Target
        If .CountLarge = 1 Then ' 仅处理单个单元格选择场景
            MoveSelectionOnExit xlNone
            Application.EnableEvents = False
                Select Case .Column
                    Case 3 ' 点击第三列时触发控件显示
                        ShowCbxAgent Target
                End Select
            Application.EnableEvents = True
        Else
            MoveSelectionOnExit xlToRight
        End If
    End With
End Sub

Private Sub ShowCbxAgent(Target As Range)
    ' FRM 029 ++ 09 Jun 2025
    
    Dim agtCode         As String
    
    If CbxAgent Is Nothing Then SetCbxAgent Me
    
    agtCode = UCase(Target.Value)
    With CbxAgent
        .Top = Target.Top - 1.5
        .Left = Target.Left
        .Object.Value = agtCode
        .Width = nbxAgent ' 确保控件宽度足够显示两列
        .Visible = True
        .Activate
    End With
End Sub

Private Sub ClearCbxAgent()
    ' FRM 029 ++ 09 Jun 2025

    On Error Resume Next
    With CbxAgent
        .ListIndex = -1
        .Visible = False
        .Width = nbxAgent
    End With
End Sub

• 在SetCbxAgent过程中，给ComboBox的*.Style*属性设置为fmStyleDropDownList：默认的fmStyleDropDownCombo样式仅显示BoundColumn内容，改为下拉列表样式后会完整展示所有列，这是实现需求的核心设置。
• 补充了缺失的全局常量（nbxAgent和CbxAgtName），确保代码可正常运行。
• 新增CbxAgentList函数，返回符合要求的双列示例数据。
• 在Worksheet_SelectionChange中增加Target.CountLarge = 1判断，避免多选单元格时触发错误。

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