Find Record on Continuous Form Access Vba
How to Highlight the Current Record in a Continuous Form
Step-by-step instructions for applying a custom highlight to the currently selected record in a continuous form in Microsoft Access.
Alternate Back Color Property
The detail section of a continuous form in Microsoft Access has an Alternate Back Color property. You can use this property to set a contrasting color that makes it easier to distinguish one record from the next.
This is a nice feature, but there is no "Active Back Color" property that you can use to highlight the currently selected record. With a clever use of Formatting Conditions, though, we can work around this limitation.
Highlighting the Active Row
The idea is to add a textbox that fills the detail section of your continuous form. You set the BackColor and ForeColor of the text box to match the detail section's BackColor. This will make the text box blend in to the background for all the rows except for the active row. Place the text box at the bottom of the Z-order (i.e., Send to Back) so that it does not obscure any of the other controls in the section.
You'll also want to set the BackStyle for most of the other controls in the detail section to Transparent, so that the highlighted text box shows through.
Within the form's current event, you then update the formatting condition so that the text box is set to a highlighting color for all records that match the current value of a unique key.
Here's what the effect looks like in practice:
The Code: HighlightRow Function
The code for the HighlightRow function is shown below.
I commented out my App.Echo code. If the user interface starts flashing, you may want to set Application.Echo to False and then back to True in the Exit_HighlightRow line. You need to be careful with setting Application.Echo to False because if your code errors out before you reset Echo to True, then your user interface will appear frozen. Unfortunately, Access does not give you a way to check the current status of Application.Echo (it's a method, not a property). I use a singleton class to work around this shortcoming; for details, see VBA Alchemy: Turning Methods into Properties.
I also commented out my custom error handling function at the bottom. If you have a standard error handler, you should use it in place of the generic MsgBox code I included.
Private Const DefaultHLColor As Long = 10092543 'RGB(255, 255, 153); Light Yellow '--------------------------------------------------------------------------------------- ' Procedure : HighlightRow ' DateTime : 2/22/2008 - 8/15/2019 14:15 ' Author : Mike ' Purpose : Highlight the detail section of a continuous form. ' Usage : 1) Add a textbox bound to a unique field (preferrably the primary key) ' to a form set to continuous view. ' 2) Set Enabled = No, Locked = Yes, BackColor = {Detail Section BackColor}, ' BackStyle = Normal, SpecialEffect = Flat, ForeColor = BackColor, ' FontSize = 1 ' 3) Expand the textbox to fill the entire detail section, Send to Back. ' 4) Add the following to the form's OnCurrent event: ' =HighlightRow([{TextBoxName}]) ' Notes : We could simply Refresh the form in the OnCurrent event, but Access ' (2002, at least) does not have a rock solid implementation of conditional ' formatting. The problem with Refreshing the form occurs when we select ' a record (which gets highlighted), then we scroll the form so the ' highlighted record is no longer visible, then select a new record, and ' scroll back to the previous record to see that, sadly, it is still ' highlighted. ' Requires : GetCurrentRecord() function '--------------------------------------------------------------------------------------- Function HighlightRow(Ctl As TextBox, Optional HLColor As Long = DefaultHLColor, _ Optional Expression As String = vbNullString) On Error GoTo Err_HighlightRow Dim CtlName As String: CtlName = Ctl.Name 'save to local variable for error tracing ' Dim SaveAppEcho As Boolean ' SaveAppEcho = App.Echo ' App.Echo = False Dim Frm As Form: Set Frm = Ctl.Parent Dim FrmName As String: FrmName = Frm.Name 'save to local variable for error tracing With Ctl .FormatConditions.Delete Dim PgmStateAllowsAddingFormatConditions As Boolean PgmStateAllowsAddingFormatConditions = False 'Check program state to be sure we won't throw an error when trying to create the new format conditions If Frm.Detail.Visible And Len(Frm.RecordSource) > 0 Then If GetCurrentRecord(Frm) <> 0 Then If Frm.CurrentRecord <= Frm.Recordset.RecordCount Then If Not IsNull(.Value) And Not IsEmpty(.Value) Then PgmStateAllowsAddingFormatConditions = True End If End If End If End If If PgmStateAllowsAddingFormatConditions Then If Len(Expression) > 0 Then .FormatConditions.Add acExpression, , Expression ElseIf IsNumeric(.Value) Then .FormatConditions.Add acFieldValue, acEqual, .Value Else .FormatConditions.Add acFieldValue, acEqual, """" & .Value & """" End If .FormatConditions(0).BackColor = HLColor .FormatConditions(0).ForeColor = HLColor .FormatConditions(0).Enabled = False End If End With Exit_HighlightRow: ' App.Echo = SaveAppEcho Exit Function Err_HighlightRow: Select Case Err.Number Case Else 'LogErr Err, Errors, "FormFunctions", "HighlightRow", elReraise MsgBox Err.Description, vbExclamation, "Error " & Err.Number End Select Resume Exit_HighlightRow End Function '--------------------------------------------------------------------------------------- ' Procedure : GetCurrentRecord ' Author : Mike Wolfe ' Source : https://nolongerset.com/getcurrentrecord/ ' Purpose : Convenience function meant to deal primarily with Error 2455: "You entered ' an expression that has an invalid reference to the property CurrentRecord." ' Notes - Always returns 0 if there is no current record, otherwise "The value ' specified by this property corresponds to the value shown in the record ' number box found in the lower-left corner of the form." '--------------------------------------------------------------------------------------- Private Function GetCurrentRecord(Frm As Form) As Long On Error Resume Next GetCurrentRecord = Frm.CurrentRecord End Function wedgwoodowbet1957.blogspot.com
Source: https://nolongerset.com/highlightrow/