ComboBox下拉列表右键特定项显示MsgBox（不选中不收起）实现咨询

我明白你的需求——右键点击ComboBox下拉列表里的项时，既不选中该项、也不收起下拉框，还要弹出提示框。默认的MouseDown事件确实会触发选中和收起，因为这是控件的默认行为，咱们来调整一下代码解决这个问题。

解决思路 #

要实现这个需求，我们需要做到三点：

1. 精准识别右键点击操作
2. 计算出右键点击的是下拉列表中的哪一项
3. 拦截控件的默认行为（避免选中项、收起下拉框）

完整代码实现 #

首先，在你的表单模块的通用声明部分添加API函数声明（用于更准确地获取下拉状态和项高度）：

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const CB_GETDROPPEDSTATE As Long = &H157  ' 获取下拉列表是否展开
Private Const CB_GETITEMHEIGHT As Long = &H153    ' 获取列表项的高度（像素）

然后替换你的ComboBox1_MouseDown事件代码：

Private Sub ComboBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim isDropDownOpen As Boolean
    Dim itemHeightPixel As Long
    Dim targetItemIndex As Long
    Dim originalSelectedIndex As Long
    
    ' 只处理右键点击（Button=2代表右键）
    If Button = 2 Then
        ' 检查下拉列表是否处于展开状态
        isDropDownOpen = SendMessage(ComboBox1.hwnd, CB_GETDROPPEDSTATE, 0, 0) <> 0
        
        If isDropDownOpen Then
            ' 记录当前选中的项，之后恢复它
            originalSelectedIndex = ComboBox1.ListIndex
            
            ' 获取每个列表项的高度（像素）
            itemHeightPixel = SendMessage(ComboBox1.hwnd, CB_GETITEMHEIGHT, 0, 0)
            
            ' 把VBA的缇（Twips）坐标转换为像素，计算点击位置在下拉列表中的偏移
            Dim yPosPixel As Long
            Dim ctrlHeightPixel As Long
            yPosPixel = Y / Screen.TwipsPerPixelY
            ctrlHeightPixel = ComboBox1.Height / Screen.TwipsPerPixelY
            
            ' 计算点击的是第几个项
            targetItemIndex = (yPosPixel - ctrlHeightPixel) \ itemHeightPixel
            
            ' 确保索引在有效范围内
            If targetItemIndex >= 0 And targetItemIndex < ComboBox1.ListCount Then
                ' 弹出提示框，显示点击的项内容
                MsgBox "你右键点击了：" & ComboBox1.List(targetItemIndex)
            End If
            
            ' 恢复原来的选中项，避免右键点击自动选中
            ComboBox1.ListIndex = originalSelectedIndex
            
            ' 强制保持下拉列表展开（默认右键点击会收起）
            ComboBox1.DropDown
        End If
    End If
End Sub

代码说明 #

• API函数：用来准确判断下拉列表是否展开，以及获取列表项的实际高度（避免因系统DPI或控件样式导致的计算误差）
• 坐标转换：VBA中鼠标事件的坐标是缇（Twips），需要转换为像素才能和API返回的高度匹配
• 恢复选中状态：记录右键点击前的选中项，之后恢复，确保不会改变用户之前的选择
• 强制展开下拉：右键点击后控件默认会收起下拉框，我们调用DropDown方法强制保持展开

注意事项 #

• 确保你的ComboBox的Style属性设置为fmStyleDropDownList（如果不需要用户输入的话），这样效果更稳定
• 如果你需要支持高DPI环境，代码已经通过Screen.TwipsPerPixelY做了适配，能应对大部分场景

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