Change header Font Colours

[sdel_nevo]

Hi All

sorry if this has been asked before



I have this code that runs in a module

Function SelectHeaderColour(frm As Form)
    On Error GoTo SelectHeaderColour_Error
    Dim HeaderColour As String
    HeaderColour = Nz(DLookup("HeaderColour", "tblCompanyDetails"), "Not Setup")
    Select Case HeaderColour
        Case Is = "Light Blue"
            If frm.Name = "frmDashboard" Then
                frm.FormHeader.BackColor = RGB(16, 100, 186)
                frm.Detail.BackColor = RGB(16, 100, 186)
            Else
                frm.FormHeader.BackColor = RGB(16, 100, 186)
            End If
        Case Is = "Dark Blue"
            If frm.Name = "frmDashboard" Then
                frm.FormHeader.BackColor = RGB(16, 50, 139)
                frm.Detail.BackColor = RGB(16, 50, 139)
            Else
                frm.FormHeader.BackColor = RGB(16, 50, 139)
            End If
        Case Is = "Black"
            If frm.Name = "frmDashboard" Then
                frm.FormHeader.BackColor = RGB(0, 0, 0)
                frm.Detail.BackColor = RGB(0, 0, 0)
            Else
                frm.FormHeader.BackColor = RGB(0, 0, 0)
            End If
        Case Is = "Dark Brown"
            If frm.Name = "frmDashboard" Then
                frm.FormHeader.BackColor = RGB(138, 51, 36)
                frm.Detail.BackColor = RGB(138, 51, 36)
            Else
                frm.FormHeader.BackColor = RGB(138, 51, 36)
            End If
        Case Is = "Crimson"
            If frm.Name = "frmDashboard" Then
                frm.FormHeader.BackColor = RGB(220, 20, 60)
                frm.Detail.BackColor = RGB(220, 20, 60)
            Else
                frm.FormHeader.BackColor = RGB(220, 20, 60)
            End If
        Case Is = "Not Setup"
            If frm.Name = "frmDashboard" Then
                frm.FormHeader.BackColor = RGB(56, 45, 89)
                frm.Detail.BackColor = RGB(56, 45, 89)
            Else
                frm.FormHeader.BackColor = RGB(56, 45, 89)
            End If
        Case Is = "Dark Green"
            If frm.Name = "frmDashboard" Then
                frm.FormHeader.BackColor = RGB(0, 100, 0)
                frm.Detail.BackColor = RGB(0, 100, 0)
            Else
                frm.FormHeader.BackColor = RGB(0, 100, 0)
            End If
        Case Is = "Purple"
            If frm.Name = "frmDashboard" Then
                frm.FormHeader.BackColor = RGB(142, 56, 142)
                frm.Detail.BackColor = RGB(142, 56, 142)
            Else
                frm.FormHeader.BackColor = RGB(142, 56, 142)
            End If
    End Select
    
    On Error GoTo 0
    Exit Function
SelectHeaderColour_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure SelectHeaderColour, line " & Erl & "."
End Function

and is called when a form opens by this code

'Get Form Header Colours
    Call SelectHeaderColour(Me) 'Taken From modUtilities

this works very well and i'm really pleased with it, but i would also like to change the font colour of all controls in the header but I cant get my head around how to do this

any help would be fantastic

Steve

[Minty]

You would have to loop through the controls that you can change the font colour on (Check boxes etc will error) and set the ForeColor property.
I'm not sure how you would identify that the control was in the Form header though... ?

Apparently like this

For Each ctl In Me.FormHeader.Controls ...

[sdel_nevo]

Hi Minty

Many thanks for the help, will look into that

Steve

[Micron]

I'm not sure how you would identify that the control was in the Form header though... ?

Assign a value to the Tag property for only the header controls and loop through the form controls collection, changing the forecolor for only those with the tag value.

[June7]

If you don't want to have to touch every control in the header section, another method is to name controls with similar names, like tbx1, tbx2, tbx3, etc. Then looping code can address only those controls:

For x = 1 to 10
Me.Controls("tbx" & x).ForeColor = vbRed
Next

How many controls are there? If only a few, maybe just addressing each one directly would be just as efficient.

[sdel_nevo]

Hi June

what a fantastic idea, will give that a go,

@micron and Minty many thanks for your help

Steve

[sdel_nevo]

Hi

I thought about this for a while and as I only wanted to change the label and textbox font colours and given that some forms had lots of controls, I tried to filter the controls in the header by type


using this code

Function SelectHeaderColour(frm As Form)
   
    Dim HeaderColour As String
    Dim ctl As Control
    
    HeaderColour = Nz(DLookup("HeaderColour", "tblCompanyDetails"), "Not Setup")
    Select Case HeaderColour
        Case Is = "Light Blue"
            If frm.Name = "frmDashboard" Then
                frm.FormHeader.BackColor = RGB(16, 100, 186)
                frm.Detail.BackColor = RGB(16, 100, 186)
            Else
                frm.FormHeader.BackColor = RGB(16, 100, 186)
            End If
        Case Is = "Dark Blue"
        
            For Each ctl In frm.FormHeader.Controls
                With ctl
                    Select Case .ControlType
                        Case acLabel
                            .ForeColor = vbRed
                        Case acTextBox
                            .ForeColor = vbRed
                    End Select
                End With
            Next ctl
                              
            If frm.Name = "frmDashboard" Then
                frm.FormHeader.BackColor = RGB(16, 50, 139)
                frm.Detail.BackColor = RGB(16, 50, 139)
                
            Else
                frm.FormHeader.BackColor = RGB(16, 50, 139)
            End If
        Case Is = "Black"
        
            For Each ctl In frm.FormHeader.Controls
                With ctl
                    Select Case .ControlType
                        Case acLabel
                            .ForeColor = RGB(255, 255, 255)
                        Case acTextBox
                            .ForeColor = RGB(255, 255, 255)
                    End Select
                End With
            Next ctl
            If frm.Name = "frmDashboard" Then
                frm.FormHeader.BackColor = RGB(0, 0, 0)
                frm.Detail.BackColor = RGB(0, 0, 0)
            Else
                frm.FormHeader.BackColor = RGB(0, 0, 0)
            End If
        Case Is = "Dark Brown"
            If frm.Name = "frmDashboard" Then
                frm.FormHeader.BackColor = RGB(138, 51, 36)
                frm.Detail.BackColor = RGB(138, 51, 36)
            Else
                frm.FormHeader.BackColor = RGB(138, 51, 36)
            End If
        Case Is = "Red"
            If frm.Name = "frmDashboard" Then
                frm.FormHeader.BackColor = RGB(220, 20, 60)
                frm.Detail.BackColor = RGB(220, 20, 60)
            Else
                frm.FormHeader.BackColor = RGB(220, 20, 60)
            End If
        Case Is = "Not Setup"
            If frm.Name = "frmDashboard" Then
                frm.FormHeader.BackColor = RGB(56, 45, 89)
                frm.Detail.BackColor = RGB(56, 45, 89)
            Else
                frm.FormHeader.BackColor = RGB(56, 45, 89)
            End If
        Case Is = "Dark Green"
            If frm.Name = "frmDashboard" Then
                frm.FormHeader.BackColor = RGB(0, 100, 0)
                frm.Detail.BackColor = RGB(0, 100, 0)
            Else
                frm.FormHeader.BackColor = RGB(0, 100, 0)
            End If
        Case Is = "Purple"
            If frm.Name = "frmDashboard" Then
                frm.FormHeader.BackColor = RGB(142, 56, 142)
                frm.Detail.BackColor = RGB(142, 56, 142)
            Else
                frm.FormHeader.BackColor = RGB(142, 56, 142)
            End If
    End Select

I managed to do what I wanted , I don't have to rename any controls or add tags, i'm not sure its the most graceful way of doing things but it works really well


Steve

[Minty]

That is probably as elegant as it could be, and has the added bonus that if you add another control to that section or rename it it will still work on those new / updated controls, as it's not hard coded.

[sdel_nevo]

Hi Minty

yes I have just added some to a form to test it, works really well, im really happy with it

its my first attempt at righting a function after one hell of a learning curve, getting there slowly now

steve