Access开发：手把手教你实现带复选框的多选下拉组合框

Hi，大家好！

用过 Web 表单的同学对这种控件一定不陌生——点击下拉箭头，弹出一个带复选框的列表，勾选完毕后自动收起，选中项以逗号分隔显示在文本框中。

但在 Access 中，原生的组合框（ComboBox）只支持单选。想要实现多选？得自己动手。

今天这篇文章，我们就来用 VBA + Windows API 从零实现一个"多选下拉复选框"控件，效果如下：

点击 ▼ 按钮 → 弹出复选框列表 → 勾选/取消 → 文本框实时显示  → 点击外部自动收起

01思路拆解

Access 没有现成的多选下拉控件，但我们可以用已有的零件"拼"出来：

核心难点有三个：

1. 定位：弹出窗体必须精确出现在文本框正下方

2. 数据同步：勾选后要立即反映到文本框

3. 交互体验：点击外部区域时自动收起

接下来逐个击破。

02数据层：一个简单的选项表

CREATE TABLE tbl_AudienceOptions (
    ID        COUNTER PRIMARY KEY,
    OptionName TEXT(50),
    IsSelected YESNO
)

IsSelected 字段存储勾选状态。这里为了演示简单直接放在表里，如果是多用户环境，建议用前端临时表或 TempVars 来存储选中状态，避免并发冲突。

03弹出窗体：连续窗体 + 无边框

创建一个窗体 frm_MultiSelect_Popup，关键属性设置：

记录源:       SELECT * FROM tbl_AudienceOptions ORDER BY ID默认视图:     连续窗体弹出方式:     是模式:         否边框样式:     无        ← 这一条很关键，让它看起来像下拉框的一部分记录选定器:   否导航按钮:     否滚动条:       只垂直

Detail 区域放两个控件：

• 复选框 chkSelected，绑定 IsSelected

• 文本框 txtOptionName，绑定 OptionName，设为锁定、透明背景、无边框

04添加通用模块

创建一个标准模块 mod_MultiSelectCombo，放置 Windows API 声明和辅助函数：

Option Compare Database
Option Explicit
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Const LOGPIXELSX As Long = 88
Private Const LOGPIXELSY As Long = 90
#If VBA7 Then
    Private Declare PtrSafe Function ClientToScreen Lib "user32" (ByVal hWnd As LongPtr, lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function MoveWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
    Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
#Else
    Private Declare  Function ClientToScreen Lib "user32" (ByVal hWnd As LongPtr, lpPoint As POINTAPI) As Long
    Private Declare  Function MoveWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
    Private Declare  Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long
    Private Declare  Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
    Private Declare  Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long
    Private Declare  Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
#End If
Public g_UpdatingDisplay As Boolean
Public Sub PositionPopupBelowControl(frmMain As Form, ctlTarget As Control, frmPopup As Form, popupWidthTwips As Long)
    Dim pt As POINTAPI
    Dim tppX As Single, tppY As Single
    Dim hDC As LongPtr
    Dim headerH As Long
    Dim targetX As Long, targetY As Long
    Dim popW As Long, popH As Long
    Dim cnt As Long
    ' 计算每像素对应的缇(Twips)数
    hDC = GetDC(0)
    tppX = 1440! / GetDeviceCaps(hDC, LOGPIXELSX)
    tppY = 1440! / GetDeviceCaps(hDC, LOGPIXELSY)
    ReleaseDC 0, hDC
    ' 获取主窗体客户区左上角的屏幕坐标 (像素)
    pt.x = 0
    pt.y = 0
    ClientToScreen frmMain.hWnd, pt
    ' 检查主窗体页眉高度
    headerH = 0
    On Error Resume Next
    headerH = frmMain.Section(acHeader).Height
    If Err.Number <> 0 Then headerH = 0
    Err.Clear
    On Error GoTo 0
    ' 计算弹出窗体的目标屏幕位置 (控件正下方)
    ' 注: Access Detail区域左侧有内边距, 需加上约120缇的修正
    targetX = pt.x + CLng((ctlTarget.Left + 260) / tppX)
    targetY = pt.y + CLng((headerH + ctlTarget.Top + ctlTarget.Height) / tppY)
    ' 计算弹出窗体的尺寸 (宽度由调用方传入, 高度按记录数自适应)
    cnt = DCount("*", "tbl_AudienceOptions")
    popW = CLng(popupWidthTwips / tppX) - 27
    popH = CLng((cnt * 350 + 50) / tppY)
    ' 移动并调整弹出窗体大小
    MoveWindow frmPopup.hWnd, targetX, targetY, popW, popH, 1
    ' 调整弹出窗体内部文本控件宽度, 使其填满可用空间
    On Error Resume Next
    frmPopup.Controls("txtOptionName").Width = popupWidthTwips - 600
    On Error GoTo 0
End Sub

05主窗体设计

在主窗体 frm_Main 上放置：

• 文本框 txtSelectedDisplay，锁定，宽度适中，用于显示选中项

• 命令按钮 btnDropdown，放在文本框右侧，显示  ▼，点击后弹出选择窗体

主窗体具体的代码：

Private Sub Form_Load()
    CurrentDb.Execute "UPDATE tbl_AudienceOptions SET IsSelected = False"
    UpdateSelectedDisplay
End Sub
Public Sub UpdateSelectedDisplay()
    Dim rs As DAO.Recordset
    Dim strList As String
    Set rs = CurrentDb.OpenRecordset("SELECT OptionName FROM tbl_AudienceOptions WHERE IsSelected = True")
    strList = ""
    Do While Not rs.EOF
        If Len(strList) > 0 Then strList = strList & ", "
        strList = strList & rs!OptionName
        rs.MoveNext
    Loop
    Me.txtSelectedDisplay.Value = strList
    rs.Close
    Set rs = Nothing
End Sub
Private Sub btnDropdown_Click()
    Dim popupName As String
    popupName = "frm_MultiSelect_Popup"
    If CurrentProject.AllForms(popupName).IsLoaded Then
        DoCmd.Close acForm, popupName
    Else
        DoCmd.OpenForm popupName
        ' 弹出宽度 = 文本框宽度 + 按钮宽度, 保持与组合框外观一致
        Dim popW As Long
        popW = Me.txtSelectedDisplay.Width + Me.btnDropdown.Width
        PositionPopupBelowControl Me, Me.txtSelectedDisplay, Forms(popupName), popW
    End If
End Sub
Private Sub txtSelectedDisplay_Click()
    btnDropdown_Click
End Sub

06弹出窗体代码

这里还要添加弹出frm_MultiSelect_Popup窗体的代码：

Private Sub chkSelected_AfterUpdate()
    If Me.Dirty Then Me.Dirty = False
    g_UpdatingDisplay = True
    On Error Resume Next
    If CurrentProject.AllForms("frm_Demo_Main").IsLoaded Then
        Forms("frm_Demo_Main").UpdateSelectedDisplay
    End If
    On Error GoTo 0
    g_UpdatingDisplay = False
End Sub
Private Sub Form_Deactivate()
    If Not g_UpdatingDisplay Then
        DoCmd.Close acForm, Me.name
    End If
End Sub
Private Sub Form_Close()
    On Error Resume Next
    If CurrentProject.AllForms("frm_Demo_Main").IsLoaded Then
        Forms("frm_Demo_Main").UpdateSelectedDisplay
    End If
End Sub

07可以扩展的方向

这个方案已经是一个可用的基础版本了，如果需要进一步完善，还可以考虑：

• "全选/取消"按钮：在弹出窗体顶部加一个页眉，放一个"全选"复选框

• 搜索过滤：在弹出窗体顶部加一个文本框，输入关键词实时过滤选项

• 通用化封装：将选项表名、主窗体名等硬编码改为参数，封装成可复用的类模块

• 多实例支持：如果一个窗体上需要多个多选下拉框，可以用 Tag 属性区分不同实例

08运行测试

1. 打开主窗体 frm_Main。

2. 点击下拉按钮，弹出选项窗体。

3. 勾选/取消选项，观察主窗体文本框显示是否正确更新。

4. 点击窗体外部，确认弹出窗体是否自动收起。

小结

整个方案没有用到任何第三方控件，纯 VBA + 原生 Access 对象 + 两三个 Windows API 函数，兼容性好，部署简单。希望对大家的 Access 开发有所帮助。

Access 开发」 专注于 Microsoft Access 开发与企业级应用，提供以下服务：

📚 技术培训

• Access VBA 从入门到精通（线上/线下）

• Access + SQL Server 企业级开发实战

• Access 系统性能优化与架构设计

💼 定制开发

• 企业 ERP/CRM/进销存等系统开发

• 旧系统升级与性能优化

🔧 技术支持

• 代码审查与重构建议

• 疑难问题远程诊断

• 一对一技术辅导

联系方式：

• 公众号后台留言

• 邮箱：will.miao@edonsoft.com

• 微信：edonsoft

技术改变业务，专注创造价值。