conditional Formating - Highlight current record

D

Djblois

Registered User.
Local time
Today, 04:58
Joined
Jan 26, 2009
Messages
598
How do I highlight all the controls in the current record? I want to highlight only the controls pertaining to the current record.
 
There is not a simpler way to do that?
 
I haven't looked at this particular hack of Lebans, but there is seldom a better/easier way to do something than the way Stephen does it!
 
Djblois said:
There is not a simpler way to do that?
Click to expand...
As previously pointed out, NO. Continuous forms and conditional formated per record is NOT easy. That is why it took someone like Stephen Leban to write the code to make it possible.


In the example, check out this form: CustomerInContinuousViewCurrentRow

It really is very easy to implement.

1) Import all the modules into your database

2) On your form, add the following:

Code: 
Option Compare Database
Option Explicit

' Declare an instance of our class
Private CF As clsConditionalFormattingDataSheetView


Private Sub Form_Current()
' Call our redraw function.
' We have to do this here because of a bug using
' Withevents to sink a Form's events from a Class module.
CF.Redraw
End Sub


Private Sub Form_Load()
' startup our class
Set CF = New clsConditionalFormattingDataSheetView
' You must set a reference to a TextBox control
' that you have placed anywhere in the Detail section.
' Don't worry about the control's size or placement.
' The class will position, size and set it's properties as required.

CF.KeyFieldControl = Me.[[b]Your Control Name Here[/b]]

' Set the desired Highlight Color
CF.HighlightColor = CLng(vbRed)   '  <<<<< this can be changed to the desired color

End Sub

Private Sub Form_Unload(Cancel As Integer)
' Release the reference to our class.
Set CF = Nothing
End Sub

In the form's On Load event You need to edit this line to have the name of a control on your form:

Code: 
CF.KeyFieldControl = Me.[[b]Your Control Name Here[/b]]
This is also where you can also change the color used.
 
Last edited:
I am getting an error right here:

Code: 
CF.ShowHighlighting = Me.tbSchTime
saying object variable or with variable not set.

I already added in all the modules and all the code to the form that you suggested

[Update] I changed the line CF.keyfieldcontrol to CF.BGtextbox and I no longer get an error but it now hides all my controls in my form.
 
Last edited:
Are you changing code in one of the modules?

Can you post all the code behind your form?
 
Here is all the code under my form:

Code: 
Option Compare Database
Option Explicit

' Declare an instance of our class
Private CF As clsConditionalFormatting


Private Sub testAddAppt()

    On Error GoTo err_handler
    
    If (Not Me.cbIncoming = 0 Or Not Me.cbOutgoing = 0) And Not Me.cobCarrier.Value = "" Then
       If Not strGroupPolicy = "Users - View Only" Then DoCmd.RunCommand acCmdSaveRecord
    End If
    Exit Sub
    
err_handler:
    
    ErrorCode


End Sub

Private Sub TestAppt(ByVal Cancel As Integer)

        If (Not Me.cbIncoming = 0 Or Not Me.cbOutgoing = 0) And Not Me.cobCarrier.Value = "" Then
            If IsNull(Me.tbArrDate) And Not IsNull(Me.tbArrTime) Then Me.tbArrDate.Value = Date
            If IsNull(Me.tbDate.Value) Then Me.tbDate.Value = Form.frmscheduled_appts.cldrApptDates.Value
            If Me.Dirty Then Me.tbModifiedby.Value = strUserLogin
            If Me.Dirty Then Me.tbModifiedDate.Value = Date
            If IsNull(Me.tbCreatedBy.Value) Then Me.tbCreatedBy.Value = strUserLogin
            If IsNull(Me.Confirmation_Num.Value) Then
                If IsNull(DMax("[Confirmation_Num]", "Scheduled_Appts")) Then
                    Me.tbConfirmation.Value = 100000
                Else
                    Me.tbConfirmation.Value = DMax("[Confirmation_Num]", "Scheduled_Appts") + 1
                End If
            End If
        ElseIf Me.cbIncoming = 0 And Me.cbOutgoing = 0 And Not Me.cobCarrier.Value = "" Then
            DoCmd.OpenForm "frmGeneralError"
            Form_frmGeneralError.lblError.Caption = "You must chose either Shipping or Recieving for this Appointment!"
            Cancel = True
        ElseIf (Not Me.cbIncoming = 0 Or Not Me.cbOutgoing = 0) And Me.cobCarrier.Value = "" Then
            DoCmd.OpenForm "frmGeneralError"
            Form_frmGeneralError.lblError.Caption = "You must chose a Carrier for this Appointment!"
            Cancel = True
        ElseIf Me.cbIncoming = 0 And Me.cbOutgoing = 0 And Me.cobCarrier.Value = "" And Not IsNull(Me.tbSchTime.Value) Then
            DoCmd.OpenForm "frmGeneralError"
            Form_frmGeneralError.lblError.Caption = "You must chose a carrier and either Shipping or Recieving for this Appointment!"
            Cancel = True
        ElseIf Me.cbIncoming = 0 And Me.cbOutgoing = 0 And Me.cobCarrier.Value = "" And Not IsNull(Me.tbSchTime.Value) _
        And IsNull(Me.tbConfirmation) And Me.tbDate = "" Then
            Me.Undo
        End If
        blnDelete = False
        'End
    

End Sub

Private Sub txtApptDate_Exit(Cancel As Integer)
    
    On Error GoTo err_handler
    
    DoCmd.Requery
    Exit Sub
    
err_handler:
    
    ErrorCode
    
End Sub

Private Sub cbIncoming_Click()

    On Error GoTo err_handler
    
    blnDelete = False
    testAddAppt
    Exit Sub
    
err_handler:
    
    ErrorCode
    
End Sub

Private Sub cbOutgoing_Click()

    On Error GoTo err_handler
    
    blnDelete = False
    testAddAppt
    Exit Sub
    
err_handler:
    
    ErrorCode
    
End Sub

Private Sub cbViewRec_Click()

    On Error GoTo err_handler

    DoCmd.Requery
    Exit Sub
    
err_handler:
    
    ErrorCode

End Sub

Private Sub cbViewShip_Click()

    On Error GoTo err_handler
    
    DoCmd.Requery
    Exit Sub
    
err_handler:
    
    ErrorCode
    
End Sub

Private Sub cmdOpenDetails_Click()

    Me.AllowEdits = True
    If Not strGroupPolicy = "Users - View Only" Then DoCmd.RunCommand acCmdSaveRecord
    dtLastViewed = Form_frmScheduled_Appts.cldrApptDates.Value
    On Error GoTo exitProc
    DoCmd.OpenForm "frmOpenDetails", , , "Appt_Id = " & Me.tbApptID
    DoCmd.Close acForm, "frmScheduled_Appts"
    
exitProc:
    Exit Sub
    
End Sub

Private Sub cobCarrier_Change()

    On Error GoTo err_handler
    
    testAddAppt
    Exit Sub
    
err_handler:
    
    ErrorCode

End Sub

Private Sub Form_Current()

    ' Call our redraw function.
    ' We have to do this here because of a bug using
    ' Withevents to sink a Form's events from a Class module.
    CF.Redraw

End Sub

Private Sub Form_Error(DataErr As Integer, Response As Integer)

    DoCmd.OpenForm "frmGeneralError"
    Form_frmGeneralError.lblError.Caption = Error$

End Sub

Private Sub Form_Load()

    ' startup our class
    Set CF = New clsConditionalFormatting

    On Error GoTo err_handler
    
    On Error Resume Next
    DoCmd.Requery
    On Error GoTo 0
    
    ' You must set a reference to a TextBox control
    ' that you have placed anywhere in the Detail section.
    ' Don't worry about the control's size or placement.
    ' The class will position, size and set it's properties as required.

    CF.BGTextBox = Me.tbArrTime
    'CF.BGTextBox = Me.Sch_Time

    ' Set the desired Highlight Color
    CF.HighlightColor = CLng(vbRed)   '  <<<<< this can be changed to the desired color

    'CF.ShowHighlighting = True
    Exit Sub
    
err_handler:
    
    ErrorCode

End Sub

Private Sub tbArrTime_Click()

    On Error GoTo err_handler

    If IsNull(Me.tbArrTime) And Not Me.NewRecord Then
        Me.tbArrTime.Value = Format(Now(), "hh:mm AM/PM")
        Me.tbArrDate.Value = Date
    End If
    Exit Sub
    
err_handler:
    
    ErrorCode

End Sub

Private Sub tbDepTime_Click()

    On Error GoTo err_handler

    If Me.AllowEdits = True And IsNull(Me.tbDepTime) And Not IsNull(Me.tbArrTime) And Not Me.NewRecord Then
        Me.tbDepTime.Value = Format(Now(), "hh:mm AM/PM")
        DoCmd.RunCommand acCmdSaveRecord
        DoCmd.OpenForm "frmCompleteAppts", , , "Appt_Id = " & Me.tbApptID
    End If
     
    Exit Sub
    
err_handler:
    
    ErrorCode

End Sub


'------------------------------------------------------------
' cmdDelete_Click
'
'------------------------------------------------------------
Private Sub cmdDelete_Click()
On Error GoTo cmdDelete_Click_Err
    
    blnDelete = True
    
    strDelRecord = "Appts"
    
    DoCmd.OpenForm "frmDelete"
    Form_frmDelete.lblError.Caption = "Are you sure you want to delete Apptointment CW" & _
    Form_frmScheduled_Appts.tbConfirmation & "?"

cmdDelete_Click_Exit:
    Exit Sub

cmdDelete_Click_Err:
    
    ErrorCode

End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)

    On Error GoTo err_handler
    
    If IsNull(Me.tbDate) Then
        If Me.cbIncoming = 0 And Me.cbOutgoing = 0 And Not Me.cobCarrier.Value = "" Then
            DoCmd.OpenForm "frmGeneralError"
            Form_frmGeneralError.lblError.Caption = "You must chose either Shipping or Recieving for this Appointment!"
            Cancel = True
        ElseIf (Not Me.cbIncoming = 0 Or Not Me.cbOutgoing = 0) And Me.cobCarrier.Value = "" Then
            DoCmd.OpenForm "frmGeneralError"
            Form_frmGeneralError.lblError.Caption = "You must chose a Carrier for this Appointment!"
            Cancel = True
        ElseIf Me.cbIncoming = 0 And Me.cbOutgoing = 0 And Me.cobCarrier.Value = "" And Not IsNull(Me.tbSchTime.Value) Then
            DoCmd.OpenForm "frmGeneralError"
            Form_frmGeneralError.lblError.Caption = "You must chose a carrier and either Shipping or Recieving for this Appointment!"
            Cancel = True
        ElseIf Me.cbIncoming = 0 And Me.cbOutgoing = 0 And Me.cobCarrier.Value = "" And Not IsNull(Me.tbSchTime.Value) _
        And IsNull(Me.tbConfirmation) And Me.tbDate = "" Then
            Me.Undo
        End If
    End If
    If IsNull(Me.tbArrTime.Value) Then Me.tbArrDate.Value = ""
    
    If Not blnDelete Then
        TestAppt Cancel
    End If
    blnDelete = False
    Exit Sub
    
err_handler:
    
    ErrorCode
    
End Sub

Private Sub cobCarrier_NotInList(NewData As String, Response As Integer)

    On Error GoTo err_handler
    
    If MsgBox("The Item Entered is not in database, would you like to add it?", vbYesNo) = vbYes Then
        CurrentDb.Execute "INSERT INTO  [Carrier Table](Carrier) " & _
                        "Values('" & NewData & "')", dbFailOnError
        Response = acDataErrAdded
    End If
    Exit Sub
    
err_handler:
    
    ErrorCode
   
End Sub
 
Ahh ... I see what happened.

I originally posted the wrong code. Before I could get it replaced, it looks likr you coped the code.


In the example database from Leban, check out this form: CustomerInContinuousViewCurrentRow

It really is very easy to implement.

1) Import all the modules into your database

2) On your form, add the following:

Code: 
Option Compare Database
Option Explicit

' Declare an instance of our class
Private CF As clsConditionalFormattingDataSheetView


Private Sub Form_Current()
' Call our redraw function.
' We have to do this here because of a bug using
' Withevents to sink a Form's events from a Class module.
CF.Redraw
End Sub


Private Sub Form_Load()
' startup our class
Set CF = New clsConditionalFormattingDataSheetView
' You must set a reference to a TextBox control
' that you have placed anywhere in the Detail section.
' Don't worry about the control's size or placement.
' The class will position, size and set it's properties as required.

CF.KeyFieldControl = Me.[[b]Your Control Name Here[/b]]

' Set the desired Highlight Color
CF.HighlightColor = CLng(vbRed)   '  <<<<< this can be changed to the desired color

End Sub

Private Sub Form_Unload(Cancel As Integer)
' Release the reference to our class.
Set CF = Nothing
End Sub

In the form's On Load event You need to edit this line to have the name of a control on your form:

Code: 
CF.KeyFieldControl = Me.[[b]Your Control Name Here[/b]]
This is also where you can also change the color used.
 
I am still getting an error on this line:

Code: 
CF.KeyFieldControl = Me.[[B]Your Control Name Here[/B]]
 
Another way you could try is

1) Add a field to the table
2) Make a macro or code that with OnClick inserts a value such as 1 in the field. Also make another one that sets the value of the field to Null on Lost focus. Add SaveRecord action to each one.
3) Base the conditional formatting of the other fields on the basis of the other field having a value of 1. That will just be [NewFieldName]=1

If you now click on the new field the formatting will appear. Click on the field in another record and the formatting will apply to that record and the other record will return to the default font.

There is also a sample data base by CDrake for Conditional Formatting in the Samples forum. I think it is on the first page.
 
That is working almost the way I like it. The only issue is what if I click on another field within the same record. How do I don't Remove the 1.
 
I have an idea that I think would work. the lines that I want to highlight are on a subform. Each line on the subform has a control with the ApptID in it for that appt. I also have a form on the Parent form that shows the ApptID of the current record. Maybe I can highlight if tbApptID is equal to the tbApptID in the parent form. I tried it but I dont think I have the right syntax because it is not working. Here is what I tried:

Code: 
[tbApptID]=[Form]![frmScheduled_Appts].[tbApptID]
Would this work?
 
Djblois said:
I am still getting an error on this line:

Code: 
CF.KeyFieldControl = Me.[[B]Your Control Name Here[/B]]
Click to expand...

Did you change Your Control Name Here to the name of a text box on your form?
 
HiTechCoach said:
Did you change Your Control Name Here to the name of a text box on your form?
Click to expand...

Yes.

I think the way i want to do it now is much better. Can someone tell me how to test if two controls from a subform and a parent field are equal in conditional formating. Here is what I tested:

Code: 
[tbApptID]=[Form]![frmScheduled_Appts].[tbApptID]
 
Djblois said:
That is working almost the way I like it. The only issue is what if I click on another field within the same record. How do I don't Remove the 1.
Click to expand...

You could have the macro or code that sets the extra fields value to 1 placed on each of the fields and the one to set it to Null on LostFocus on each field. That way the 1 will stay while you click different fields because clicking on each field will reset the 1.

But when you click on a field in another record then the extra field on the previous record where you were clicking will become Null
 
Mike,

will the way I am trying work? it seems much simplier than your method. Can I just test one control if equal to the value in a control on the parent form then highlight it? It seems like it should work but I think my syntax is wrong.
 
If you have a continuous form and the fields are across a rwo what I have given you is very easy.

In Form design go to the left of the row and highlight the fields with the Richt Clicker and a box will pop up, click properties and a box will pop up Mulitiple Selections. You go to Events. Now add the macro or code to the OnClick to set the extra field to 1 and the macro or code to the OnLostFocus to set the value of the extra field to Null. Then do your conditional formatting on the basis of [NewExtraFieldName]=1

I am not inlclined to play with the other method as I have not looked at it and don't have the time at the moment to go trhough it.
 
Djblois said:
Mike,

will the way I am trying work? it seems much simplier than your method. Can I just test one control if equal to the value in a control on the parent form then highlight it? It seems like it should work but I think my syntax is wrong.
Click to expand...

Did you get the code to work to highlight the current record?

Is this a new task to highlight records based on a value on the parent form, no the current record? ?
 
You must log in or register to reply here.

Similar threads

J
How to create text field in form to be highlighted when selected?
2
Replies
20
Views
590
Isaac
Isaac
J
undo conditional format.
Replies
8
Views
458
John Sh
J
T
Solved Attache files from main form to Outlook
Replies
11
Views
459
June7
June7
C
Solved No Current Record on Access Close
Replies
11
Views
886
Pat Hartman
P
D
Subform requery is starting a new record
Replies
4
Views
508
dullster
D

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom