vba 在 MS Access 表单中，如何为所选记录的背景着色？

In MS Access form, how to color background of selected record?

提问by PowerUser

I have a somewhat complicated looking Access Form with a continuous display (meaning multiple records are shown at once). I'd like to change the background color of the selected record onlyso the end-user can easily tell which record they are on.

我有一个看起来有点复杂的访问表单，它具有连续显示（意味着一次显示多条记录）。我只想更改所选记录的背景颜色，以便最终用户可以轻松分辨出他们所在的记录。

I'm thinking of perhaps a conditional format or maybe something like this:

我正在考虑可能是条件格式或类似的东西：

Private Sub Detail_HasFocus()
    Detail.BackColor(me.color)=vbBlue
End Sub

and something similar for when that row loses focus. This code snippet obviously won't work, but it's the kind of code I'd like to achieve.

以及该行失去焦点时的类似内容。这个代码片段显然不起作用，但它是我想要实现的代码。

回答by C Perkins

Here is a complete solution that correctly treats newly-edited records, as well as handles Access UI quirks (i.e. failed re-paints, inconsistent behavior depending on how a record is selected--via mouse or keyboard or record selector, etc.). I include verbose comments, because Access requires thorough explanations due to its many inconsistencies and/or bugs. I have attempted leaner solutions, but inevitably it does not behave well without the tricks to force Access to repaint the form, or complicated ways for determining the current record within the Detail_Paint() event handler.

这是一个完整的解决方案，可以正确处理新编辑的记录，并处理 Access UI 怪癖（即失败的重绘、不一致的行为取决于选择记录的方式——通过鼠标或键盘或记录选择器等）。我包含了详细的注释，因为 Access 由于其许多不一致和/或错误而需要彻底的解释。我尝试了更精简的解决方案，但如果没有强制 Access 重新绘制表单的技巧，或者在 Detail_Paint() 事件处理程序中确定当前记录的复杂方法，它不可避免地表现不佳。

The code is for an Access form with a textbox bound to an ID Autonumber field. The form also has a Rectangle control named boxCurrent which is updated to highlight the currently-selected record (it has a wide brightly-colored border). I find a Rectangle control offers more visual options than setting Detail.BackColor, although such details are openly configurable using the overall pattern. Developed and tested with Access 2013 and 2016.

该代码适用于带有绑定到 ID 自动编号字段的文本框的 Access 表单。该窗体还有一个名为 boxCurrent 的 Rectangle 控件，它被更新以突出显示当前选定的记录（它有一个宽的明亮的边框）。我发现 Rectangle 控件比设置 Detail.BackColor 提供了更多的视觉选项，尽管这些细节可以使用整体模式公开配置。使用 Access 2013 和 2016 进行开发和测试。

'* Set this value in From_Current event handler
Private vCurrentAutonumber As Variant

Private Sub Detail_Paint()
  '* Delcare static variables to make often repeated calls more efficient.
  Static iActive As Integer
  Static vThisValue As Variant, vOldValue As Variant

  On Error Resume Next
  iActive = 0 '* Default to False/hidden value

  vThisValue = Me.ID.Value
  If Err.Number = 0 Then
    If Not IsNull(vCurrentAutonumber) Then
      If vThisValue = vCurrentAutonumber Then iActive = 1
    ElseIf Me.NewRecord Then
      '* Form currently set to "New Record", but may or may not be in edit mode.
      '* When in EDIT MODE, AutonumberControl.Value will HAVE A VALUE
      '      AND AutonumberControl.OldValue will be null
      '   When NOT in edit mode, AutonumberControl.Value will be null
      '      AND AutonumberControl.OldValue will also be null
      '*** That is the only way I have found to determine for sure
      '    if the currently-edited-new-record is the available record for
      '    this particular call of Detail_Paint().
      '    Other properties like CurrentRecord, NewRecord, etc. remain
      '    unchanged during repeated calls to Detail_Paint()
      '    and access has no other convenient way to determine the
      '    newly-added autonumber value, so it must be deduced using
      '    this trick.

      If IsNull(vThisValue) Then
        If Not Me.Dirty Then
          'Record selector on *(New Record) row, but not edited yet.
          If Err.Number = 0 Then iActive = 1
        End If
      Else
        vOldValue = Me.ID.OldValue
        If Err.Number = 0 Then
          If IsNull(vOldValue) Then
            '* Newly-edited record with fresh autonumber value is selected.
            iActive = 1

          'Else if vOldValue is not null, it is an existing record.
          '*  Not the current record since it can't be both existing and new.
          End If
        End If
      End If
    End If
  End If

  '* Set these values on EACH CALL, since their values will be retained
  '* on subsequent calls.
  With boxCurrent
    .BackStyle = 0 'iActive
    .BorderStyle = iActive
  End With

End Sub

Private Sub Form_AfterDelConfirm(Status As Integer)
  Me.Repaint
End Sub

Private Sub Form_AfterInsert()
  If IsNull(vCurrentAutonumber) Then
    '* If a new record is saved while staying on that record,
    '*  the Form_Current() handler is not called and so the
    '*  vCurrentAutonumber would not be updated with the newly
    '*  saved value.  But now Me.NewRecord is false, so the
    '*  currently record would not be updated properly unless
    '*  vCurrentAutonumber is explicitly updated here.
    On Error Resume Next
    vCurrentAutonumber = Me.ID.Value

    '* Force repaint (see comment in Form_Current)
    boxCurrent.BackColor = vbBlue
  End If
End Sub

'Private Sub Form_BeforeInsert(Cancel As Integer)
  '* Attempted to set some variable or property in this event handler
  '*    --something to indicate to Detail_Paint() which record is the
  '*    new record being edited.  But no matter what I set here, the
  '*    change is present and identical for each call of Detail_Paint(),
  '*    so for the most part this technique was not useful.
  '*    The only alternative is to set one of the data fields, because
  '*    those DO change for each each to Detail_Paint().
  '*    IF THE PRIMARY KEY IS NOT AN AUTONUMBER FIELD (OR IF ANOTHER
  '*    DATA FIELD IS AVAILABLE TO MANIPULATE), ONE COULD FLAG A NEWLY
  '*    EDITED RECORD BY SETTING SUCH A FIELD HERE AND INSPECTING
  '*    it in Detail_Paint().  Personally, I avoid dummy fields just for
  '*    making Access work well and my primary key is Autonumber so it cannot
  '*    bet set to a known new value.
'End Sub

Private Sub Form_Current()

  On Error Resume Next
  vCurrentAutonumber = Me.ID.Value
  If Err.Number <> 0 Then vCurrentAutonumber = Null
  On Error GoTo 0

  '*** FORCE REPAINT of record detail section
  '* If not forced, records are not necessarily repainted for every type of
  '*    UI event.  For instance, changing records using the record selectors
  '*    has different behavior than clicking inside a record, but either way
  '*    the current record has changed and so should be repainted.
  '* But calling Me.Repaint is not sufficient to actually repaint the form.
  '*    Even if the Detail_Paint event is called, the actual visible elements
  '*    are not always repainted (bug?).  It seems that only changing some
  '*    visible feature/control of the form will force an actual repaint.
  boxCurrent.BackColor = vbBlue
End Sub

Private Sub Form_Load()
  vCurrentAutonumber = Null
End Sub

回答by PowerUser

OP here. Cade pointed out that the original solution's link points to a '97 db which may not be openable anymore. Also, unfortunately, my original code is long since gone.

在这里。Cade 指出原始解决方案的链接指向一个 '97 db，它可能无法再打开。另外，不幸的是，我的原始代码早已消失。

However, I recently did something like this using the conditional formatting method which requires no VBA. This is in Access 2016 on a Continuous Form:

但是，我最近使用不需要 VBA 的条件格式方法做了类似的事情。这是在 Access 2016 中的连续形式：

1. In your dataset, add a yes/no field. Let's call it Rcd_Selected.
2. Make a text box. Also set the Control Source to Rcd_Selected.
3. Change the Fore Color to #FFFFFF (This will be the non-selected color)
4. Change Format to 'True/False'
5. Set Enabled=Yes,Locked=No
6. In the Ribbon, go to Format->Conditional Formatting and make a new rule: Where Field Value =True, set the fore color and back color to your Selected color and click on Enabled.
7. Clean up by stretching the text box over the entire Detail section and moving it to the back.
8. Make a check box field. Sent the Control Source to Rcd_Selected.
9. Stretch the checkbox over the entire Detail section and move it to the front.

1. 在您的数据集中，添加是/否字段。我们称之为 Rcd_Selected。
2. 制作一个文本框。还将控制源设置为 Rcd_Selected。
3. 将前景色更改为#FFFFFF（这将是未选择的颜色）
4. 将格式更改为“真/假”
5. 设置启用=是，锁定=否
6. 在功能区中，转到 Format->Conditional Formatting 并制定新规则：Where Field Value = True，将前景色和背景色设置为您选择的颜色，然后单击启用。
7. 通过在整个细节部分拉伸文本框并将其移到后面来清理。
8. 制作一个复选框字段。将控制源发送到 Rcd_Selected。
9. 在整个细节部分拉伸复选框并将其移动到前面。

Whenever you click on the area, the checkbox will turn on/off triggering the conditional formatting of the textbox in the background to change color. One limitation of this is that it makes the entire record read-only. I've never had speed issues and it works when multiple records are selected and un-selected.

每当您单击该区域时，复选框将打开/关闭触发背景中文本框的条件格式以更改颜色。这样做的一个限制是它使整个记录只读。我从来没有遇到过速度问题，它在选择和取消选择多个记录时都有效。

回答by GregR

One more way for continuous forms...

连续形式的另一种方法......

1. In the Form's Form_Current event set a TempVar to equal the value of the current record ID e.g. ` TempVars!CurrentRecordID = Me.ID_xxx.value Me.ControlName.Refresh 'This must one of the conditionally formatted controls per Step 2 below NB. the second line of code above is necessary for the conditional formatting to be triggered. You only need to refresh one of the conditionally formatted controls.
2. Conditional Formatting rule expression is: [ID_xxx]=[TempVars]![CurrentRecordID]and set the desired formatting e.g. BackColor
   3. Apply step 2 to any control that you want conditionally formatted when the record is selected.
   4. Only the controls on the current record are highlighted

1. 在 Form 的 Form_Current 事件中，将 TempVar 设置为等于当前记录 ID 的值，例如 ` TempVars!CurrentRecordID = Me.ID_xxx.value Me.ControlName.Refresh '这必须是 NB 下面第 2 步中的条件格式控件之一。上面的第二行代码是触发条件格式所必需的。您只需要刷新条件格式的控件之一。
2. 条件格式规则表达式为：[ID_xxx]=[TempVars]![CurrentRecordID]并设置所需的格式，例如 BackColor
   3. 将步骤 2 应用于您希望在选择记录时有条件地格式化的任何控件。
   4. 仅突出显示当前记录上的控件

---

---

Private Sub Form_Current()

10       On Error GoTo Form_Current_Error

  '=============================================================


20     TempVars!CurrentRecordID = Me.MatterID.Value

30      Me.fldDateEngagedEnquiry.Requery


'================================================================

MyExit:

40       On Error GoTo 0

50       Application.Screen.MousePointer = 0 'reset to default mouse pointer

60       Exit Sub

Form_Current_Error:

70        MsgBox "Code Line Number: " & Erl & vbCrLf & vbCrLf & "Error " & Err.Number & vbCrLf & vbCrLf & " (" & Err.Description & ") in procedure " & vbCrLf & vbCrLf & " Form_Current of Sub Form_frmMyMatters_SVR"

80        GoTo MyExit

End Sub