access突出显示匹配的内容

在程序中，我们希望能按筛选的条件高亮突出显示搜索到的符合要求的内容。

先选择字段，再选择具体的内容。回车即可显示匹配的内容。 

详细源代码：

Private Const conMod = "Form_frmSearchHighlight"    'For error handler.

Private Sub cboField_AfterUpdate()
On Error GoTo Err_Handler
    'Purpose:   Locate the display text box over the field to be searched,
    '               and fire the search code.
    'Note:      On forms where controls have different widths and heights,
    '               you will need to set Width and Height as well.
    Dim ctl As Control
    
    If Not IsNull(Me.cboField) Then
        'Set ctl to the control named in the combo.
        Set ctl = Me(Me.cboField)
        'Locate the search display on top of the control is simulates.
        With Me.txtSearchDisplay
            .Top = ctl.Top
            .Left = ctl.Left
        End With
    End If
    
    Call txtSearchText_AfterUpdate

Exit_Handler:
    Set ctl = Nothing
    Exit Sub

Err_Handler:
    Call LogError(Err.Number, Err.Description, conMod & ".cboField_AfterUpdate")
    Resume Exit_Handler
End Sub

Private Sub Form_Load()
On Error GoTo Err_Handler
    'Purpose:   Initialize: clear the search text, and hide the display box.
    
    Me.txtSearchText = Null
    Call cboField_AfterUpdate

Exit_Handler:
    Exit Sub

Err_Handler:
    Call LogError(Err.Number, Err.Description, conMod & ".Form_Load")
    Resume Exit_Handler
End Sub

Private Sub txtSearchDisplay_Enter()
On Error GoTo Err_Handler
    'Purpose:   Set focus to the real text box if the user clicks this one,
    '               as it cannot be edited.
    
    If Not IsNull(Me.cboField) Then
        Me(Me.cboField).SetFocus
    End If
    
Exit_Handler:
    Exit Sub

Err_Handler:
    Call LogError(Err.Number, Err.Description, conMod & ".txtSearchDisplay_Enter")
    Resume Exit_Handler
End Sub

Private Sub txtSearchText_AfterUpdate()
On Error GoTo Err_Handler
    'Purpose:   Filter, and highlight matches in txtSearchDisplay.
    Dim strField As String              'The field to search
    Dim strSearchValue As String        'The value to find
    Dim strControlSource As String      'ControlSource for displaying match.
    Const strcWildcard = "*"            'Some other back ends use %
    'HTML tags for highlighting matches. Could be just "<b>" and "</b>".
    Const strcTagStart = "<font color=""""red"""">"
    Const strcTagEnd = "</font>"
    
    'Save any edits.
    If Me.Dirty Then
        Me.Dirty = False
    End If
    
    'Apply a filter only if user chose a field and a value.
    If IsNull(Me.cboField) Or IsNull(Me.txtSearchText) Then
        If Me.FilterOn Then
            Me.FilterOn = False
        End If
        Call ShowHide(Me.txtSearchDisplay, False)
    Else
        strField = "[" & Me.cboField & "]"  'Cope with spaces in field name.
        strSearchValue = Me.txtSearchText
        'Apply the filter
        Me.Filter = strField & " Like """ & strcWildcard & strSearchValue & strcWildcard & """"
        Me.FilterOn = True
        
        'Control Source for the text box to display matches.
        strControlSource = "=IIf(" & strField & " Is Null, Null, " & _
            "Replace(" & strField & ", """ & strSearchValue & """, """ & _
            strcTagStart & strSearchValue & strcTagEnd & """))"
        With Me.txtSearchDisplay
            .ControlSource = strControlSource
            .Visible = True
        End With
    End If

Exit_Handler:
    Exit Sub

Err_Handler:
    Call LogError(Err.Number, Err.Description, conMod & "txtSearchText_AfterUpdate")
    Resume Exit_Handler
End Sub

Private Function ShowHide(ctl As Control, bShow As Boolean)
On Error GoTo Err_Handler
    'Purpose:   Show or hide the control, moving focus if it has focus.
    Dim strActiveControl As String      'Name of active control on this form.
    Dim strSafeControl As String        'Name of a control we can set focus to.
    
    If ctl.Visible <> bShow Then
        'Get the active control name. Will error in Form_Load.
        strActiveControl = Me.ActiveControl.Name
        'Move focus if it's the one we are trying to hide.
        If (strActiveControl = ctl.Name) And Not bShow Then
            strSafeControl = Me.cboField.ItemData(0)
            Me(Nz(Me.cboField, strSafeControl)).SetFocus
        End If
        ctl.Visible = bShow
    End If

Exit_Handler:
    Exit Function

Err_Handler:
    'In Form_Load, there's no active control yet, so ActiveControl.Name yields error 2474.
    If Err.Number = 2474& Then
        Resume Next
    Else
        Call LogError(Err.Number, Err.Description, conMod & ".ShowHide")
        Resume Exit_Handler
    End If
End Function

Private Function LogError(ByVal lngErrNumber As Long, ByVal strErrDescription As String, _
    strCallingProc As String, Optional vParameters, Optional bShowUser As Boolean = True) As Boolean
    'This skeleton function substitutes for the error logging function found here:
  
    
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, strCallingProc
End Function

源码参考自：Allen Browne的博客