Controling colors of controls in userform

[TryingToLearn]

I have a userform with 24 text and combo boxes. Aside from using the enter and exit events, is there an easy way to have the active text/combo box be highlighted in a color?

TIA

 

[Colo]

Hello TryingToLearn, Hi Noir thanks for testing!

TryingToLearn, as you said XL97 cannot handle RaiseEvent.
Here is the latest version for XL97.

How can I change the code to have this highlighting occur in ALL the userforms in my project?

All you have to do is, place the "Common code for UserForms" in each one of Userforms modules.
Hope it works as intended.

'---------Common code for UserForms ---------
'// You need place these procedures in each one of Userforms modules
Option Explicit

Private Sub UserForm_Initialize()
    RegFrm Me
End Sub

Private Sub UserForm_Activate()
    GetFocus Me
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Set objPre = Nothing
End Sub

'--------- Code for a Standard Module ---------
Option Explicit
Public objPre As MSForms.Control
'// Change here if you would like to chage colors
Private Const NormalColor As Long = &HFFFFFF 'White
Private Const HilightColor As Long = &HFFFF& 'Yellow
Private arrTxb() As New Class1
Private arrCmb() As New Class1

Public Sub RegFrm(ByVal frm As UserForm)
    Dim obj As MSForms.Control, i As Long, j As Long
    For Each obj In frm.Controls
        If TypeName(obj) = "TextBox" Then
            ReDim Preserve arrTxb(i)
            Set arrTxb(i) = New Class1
            arrTxb(i).SetTextBox obj
            i = i + 1
        End If
        If TypeName(obj) = "ComboBox" Then
            ReDim Preserve arrCmb(j)
            Set arrCmb(j) = New Class1
            arrCmb(j).SetComboBox obj
            j = j + 1
        End If
    Next
End Sub

Public Sub LostFocus(ByVal obj As MSForms.Control)
    If IsObjCtrl(obj) Then obj.BackColor = NormalColor
    Application.OnTime Now, "'GetFocus " & obj.Parent.Name & "'"
End Sub

Public Sub GetFocus(ByVal frm As UserForm)
    If IsObjCtrl(frm.ActiveControl) Then frm.ActiveControl.BackColor = HilightColor
    Set objPre = frm.ActiveControl
End Sub

Private Function IsObjCtrl(ByVal obj As Object) As Boolean
    Dim arrCtrls As Variant
    arrCtrls = Array("TextBox", "ComboBox")
    If Not IsError(Application.Match(TypeName(obj), arrCtrls, 0)) Then IsObjCtrl = True
End Function

'--------- Code for a Class Module Named Class1 ---------
Option Explicit

Public WithEvents cls_txb As MSForms.TextBox
Public WithEvents cls_cmb As MSForms.ComboBox

Sub SetTextBox(ByVal txb As MSForms.TextBox)
    Set cls_txb = txb
End Sub

Sub SetComboBox(ByVal cmb As MSForms.ComboBox)
    Set cls_cmb = cmb
End Sub

Private Sub cls_txb_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
                              ByVal X As Single, ByVal Y As Single)
    LostFocus objPre
End Sub

Private Sub cls_cmb_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
                              ByVal X As Single, ByVal Y As Single)
    LostFocus objPre
End Sub

Private Sub cls_txb_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _
                            ByVal Shift As Integer)
    CallLoastFocus KeyCode, cls_txb
End Sub

Private Sub cls_cmb_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _
                            ByVal Shift As Integer)
    CallLoastFocus KeyCode, cls_cmb
End Sub

Private Sub CallLoastFocus(ByVal KeyCode As Long, ByVal MSFCtrl As MSForms.Control)
    If KeyCode = 13 Or KeyCode = 9 Or KeyCode = 40 Or KeyCode = 38 Then
        LostFocus MSFCtrl
    End If
End Sub

 

[TryingToLearn]

EXCELLENT! Much appreciated!

 

[Luc]

Multipage

Hi,

The last couple of hours, I'm trying to get this code working in a userform which contains the multipage control,

Can somebody give me a hint how to proceed ?

Thx

Luc

 

[saurabh.chauhan]

Hi TryingToLearn,

Sorry, as far as I know, there is NO easy way.
I made a class module for you. Please try this code.
If you do not understand, please ask me anything.

'--Userform1 modile Code
 
Option Explicit
 
Private WithEvents objForm As Class1
 
Private Sub UserForm_Initialize()
    Set objForm = New Class1
End Sub
 
Private Sub UserForm_Activate()
    If TypeName(ActiveControl) = "ComboBox" Or _
       TypeName(ActiveControl) = "TextBox" Then
        ActiveControl.BackColor = &HC0E0FF
    End If
    objForm.CheckActiveCtrl Me
End Sub
 
Private Sub objForm_GetFocus()
    ActiveControl.BackColor = &HC0E0FF
End Sub
 
Private Sub objForm_LostFocus(ByVal strCtrl As String)
    Me.Controls(strCtrl).BackColor = &HFFFFFF
End Sub
 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Set objForm = Nothing
End Sub
 
'--Class Module Code (named Class1)
Public Event GetFocus()
Public Event LostFocus(ByVal strCtrl As String)
Private strPreCtr As String
 
Public Sub CheckActiveCtrl(objForm As MSForms.UserForm)
    With objForm
        If TypeName(.ActiveControl) = "ComboBox" Or _
           TypeName(.ActiveControl) = "TextBox" Then
            strPreCtr = .ActiveControl.Name
            On Error GoTo Terminate
            Do
                DoEvents
                If .ActiveControl.Name <> strPreCtr Then
                    If TypeName(.ActiveControl) = "ComboBox" Or _
                       TypeName(.ActiveControl) = "TextBox" Then
                        RaiseEvent LostFocus(strPreCtr)
                        strPreCtr = .ActiveControl.Name
                        RaiseEvent GetFocus
                    End If
                End If
            Loop
            End If
        End With
Terminate:
    Exit Sub
End Sub

Hi

Please help to add smilies to Userform...

Thanks
saurabh

 

[saurabh.chauhan]

Hi

please help to add smili to userform.