ACCESS VBA：连续子窗体鼠标追踪高亮行失效问题求助

问题背景 #

需求为在Access连续子窗体中追踪鼠标位置，通过BackRow文本框实现鼠标所在行的高亮效果。

已实现方案 #

• 利用透明按钮Selector的OnMouseMove事件触发追踪逻辑
• 调用GetCursorPos、ScreenToClient、GetScrollInfo等API获取鼠标坐标与滚动条状态
• 计算对应记录行的AbsolutePosition，更新子窗体无绑定文本框CL/CLH
• 通过**条件格式(CF)**对比CL/CLH与主键字段值实现行高亮

故障现象 #

• IDE窗口打开时功能正常（仅存在轻微延迟）
• 关闭IDE后条件格式完全失效，状态栏持续显示Calculating...
• 滚动子窗体后高亮会短暂恢复，但很快再次失效
• 已排除控件重叠、WS_DOUBLELAYERED属性影响

核心问题分析 #

1. AbsolutePosition的不可靠性：Access编译后（关闭IDE），Recordset.AbsolutePosition会因记录集缓存、筛选/排序变化出现偏移，滚动后记录集重新加载时计算行号完全失准
2. 条件格式的表达式依赖：直接引用未绑定文本框CL/CLH作为CF触发条件，编译后Access表达式引擎因窗体刷新优先级问题，无法实时同步文本框值
3. 鼠标事件的冗余计算：MouseMove事件触发过于频繁，编译后UI线程被大量计算占用，导致状态栏持续显示Calculating...，CF无法及时更新

针对性修复方案 #

1. 替换AbsolutePosition为可靠的行定位方式 #

放弃使用AbsolutePosition，改用**记录集书签(Bookmark)**定位，彻底避免行号偏移问题：

' 原代码中AbsolutePosition相关逻辑替换为：
With rstRows.Clone
    ' 先移动到滚动条偏移后的起始行
    .MoveFirst
    .Move GetScrollbarPos(SubformControl.Form, stVertical) - 1
    ' 再根据鼠标Y坐标计算偏移行数
    .Move Int((PT.y - SubformControl.Form.FormHeader.Height / TwipsPerPixely) / ((Selector.Height + 1) / TwipsPerPixely))
    ' 直接用主键值更新CLH
    ParentForm.CLH = .Fields(0).Value
End With

2. 优化条件格式的触发逻辑 #

删除原有动态添加的CF，改为窗体加载时静态绑定，同时在CLH更新时强制刷新子窗体：

' 窗体加载时初始化条件格式（仅执行一次）
Private Sub Form_Load()
    ' 清除原有CF
    FRM.BackRow.FormatConditions.Delete
    ' 添加鼠标行高亮CF（直接绑定主窗体CLH）
    With FRM.BackRow.FormatConditions.Add(acExpression, acEqual, "[ID]=Forms!主窗体名!CLH")
        .BackColor = FRM.PageHeaderSection.BackColor
        .ForeColor = FRM.PageHeaderSection.BackColor
    End With
    ' 添加选中行高亮CF
    With FRM.BackRow.FormatConditions.Add(acExpression, acEqual, "[ID]=Forms!主窗体名!CL")
        .BackColor = FRM.FormFooter.BackColor
        .ForeColor = 4144959
    End With
End Sub

' 在Selector_MouseMove事件更新CLH后添加强制刷新
ParentForm.CLH = .Fields(0).Value
' 仅刷新当前可见行，避免全窗体刷新卡顿
SubformControl.Form.Refresh

3. 减少MouseMove事件的冗余计算 #

添加鼠标位置防抖，避免每帧都触发计算：

' 模块级变量存储上次计算的行号和时间
Private lngLastRow As Long
Private dtLastCalc As Date

' 在MouseMove事件开头添加防抖判断
If Now() - dtLastCalc < TimeSerial(0,0,0,100) Then Exit Sub ' 100ms防抖
dtLastCalc = Now()
' 后续计算逻辑...

4. 解决编译后表达式引擎卡顿问题 #

将未绑定文本框CLH的控件来源设置为=Forms!主窗体名!CLH，直接绑定到主窗体变量，避免Access表达式引擎重复计算

最终调整后的关键代码片段 #

Selector_MouseMove事件优化版 #

Private Sub Selector_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Const CPN = "clsFormAsTable\PositionControls"
On Error GoTo EROARE

Dim PT As POINTAPI
Dim cRowOffset As Long
Static lngLastRow As Long
Static dtLastCalc As Date

' 防抖：100ms内不重复计算
If Now() - dtLastCalc < TimeSerial(0, 0, 0, 100) Then GoTo IESIRE
dtLastCalc = Now()

If Not ParentForm.Recordset Is Nothing Then
    If ParentForm.Recordset.EOF Or ParentForm.Recordset.BOF Then ParentForm.Recordset.MoveFirst
    
    If blnTrackMouse Then
        GetCursorPos PT
        ScreenToClient SubformControl.Form.hwnd, PT
    
        ' 鼠标超出有效区域时重置
        If PT.y > 40 Then
            If Nz(ParentForm.CL, "") <> "" Then
                If PT.x < listRC.X1 + 40 Or PT.x > listRC.X2 - 40 Or PT.y < listRC.Y1 + 40 Or PT.y > listRC.Y2 - 40 Then
                    ParentForm.CLH = ParentForm.CL
                    SubformControl.Form.Refresh
                    GoTo IESIRE
                End If
            Else
                GoTo IESIRE
            End If
        End If
    
        ' 计算滚动条偏移+鼠标行偏移
        cRowOffset = GetScrollbarPos(SubformControl.Form, stVertical) - 1
        cRowOffset = cRowOffset + Int((PT.y - SubformControl.Form.FormHeader.Height / TwipsPerPixely) / ((Selector.Height + 1) / TwipsPerPixely))
    
        If cRowOffset >= 0 Then
            With rstRows.Clone
                .MoveFirst
                .Move cRowOffset
                ' 仅当行号变化时更新
                If .Fields(0).Value <> ParentForm.CLH Then
                    ParentForm.CLH = .Fields(0).Value
                    ' 强制刷新子窗体可见行
                    SubformControl.Form.Refresh
                End If
            End With
        End If
    End If
End If

IESIRE:
Exit Sub

EROARE:
    Debug.Print "EROARE:" & Err.Description, CPN, True
    Resume IESIRE
End Sub

内容的提问来源于stack exchange，提问作者Adelina Andreea trandafir