[Resolvido]Pintar rotulo quando o campo receber foco

Prezados vi alguns topicos referente ao pintar campo ao receber foco mas meu objetivo eh que quando o campo receber foco, o rotulo tambem altera a cor de fundo.

Código:

Private Sub SuaCaixaTexto_GotFocus()
    Me.SuaCaixaTexto.BackColor = vbRed
    Me.SeuRotulo.BackStyle = 1 '1 é fundo normal, 2 é fundo transparente, com 2 não consegue alterar a cor de fundo
    Me.SeuRotulo.BackColor = vbRed
End Sub

Private Sub SuaCaixaTexto_LostFocus()
    Me.SuaCaixaTexto.BackColor = vbWhite
    Me.SeuRotulo.BackStyle = 1 '1 é fundo normal, 2 é fundo transparente, com 2 não consegue alterar a cor de fundo
    Me.SeuRotulo.BackColor = vbWhite
End Sub

Grande JPaulo, funfou legal mas, teria como transformar este codigo em um modulo (funcao), tenho mais de 50 campos em alguns formularios. Sinceramente estou ha dias com alguns probleminhas no trabalho que nao me deixam raciocinar normalmente.

Boa tarde Avelino, eu ja conheco este codigo mas nao estou conseguindo adaptar seu exemplo ao meu objetivo que e alterar o fundo do rotulo juntamente com o campo. Alguns dos formularios possuem mais de 50 campos divididos em guias.

Realmente nao estou conseguindo me concentrar nessa situacao estou com um problema com o banco de dados onde trabalho que ja estamos trabalhando a dias sem identificar a causa.
este e o codigo do Avelino que estou tentando adaptar no meu projeto (minhas alteracoes estao em destaque) so que ao abri o formulario me da erro "variavel do objeto ou variavel do bloco "with" nao foi definida" e pedindo para depurar me encaminha para o seguinte:

"ctl.OnGotFocus = "=fncPintaCampo([" & ctl.Name & "], [" & rtl.Name & "],1)" 'Cor Amarela"



Public Function fncMontaEventos(frm As Form)
Dim ctl As Control
Dim rtl As Label

For Each ctl In frm.Controls
Select Case ctl.ControlType

Case acTextBox, acComboBox, acListBox 'caixa texto, combobox e listbox

If ctl.OnGotFocus = vbNullString Then ctl.OnGotFocus = "=fncPintaCampo([" & ctl.Name & "], [" & rtl.Name & "],1)" 'Cor Amarela

If ctl.OnLostFocus = vbNullString Then ctl.OnLostFocus = "=fncPintaCampo([" & ctl.Name & "], [" & rtl.Name & "],0)" 'Cor Branca[/color]

End Select
Next
End Function

Public Function fncPintaCampo(ctl As Control, rtl As Label, cor As Byte)

ctl.BackColor = Switch(cor = 0, RGB(255, 255, 255), cor = 1, RGB(255, 253, 185))
rtl.BackColor = Switch(cor = 0, RGB(255, 255, 255), cor = 1, RGB(255, 253, 185))

If cor = 1 Then ctl.SelStart = Len(ctl.Value & "")
End Function

Galera na tentativa de solucionar minha questao hoje o codigo esta assim, mas quando "chamo" o formulario da erro em tempo de execucao '2465' (erro de definicao de aplicativo ou de definicao de obejto).


Public Function fncMontaEventos(frm As Form)
Dim ctl As Control
Dim rtl As Label

For Each ctl In frm.Controls
   Select Case ctl.ControlType
       
       Case acTextBox, acComboBox, acListBox 'caixa texto, combobox e listbox
           
           If ctl.OnGotFocus = vbNullString Then ctl.OnGotFocus = "=fncPintaCampo([" & ctl.Name & "],1)"  'Cor Amarela
           
           If ctl.OnLostFocus = vbNullString Then ctl.OnLostFocus = "=fncPintaCampo([" & ctl.Name & "],0)" 'Cor Branca
       
      Case acCommandButton 'botões
           If ctl.OnGotFocus = vbNullString Then ctl.OnGotFocus = "=fncPintaBotao([" & ctl.Name & "], 255)" 'cor vermelha
           If ctl.OnLostFocus = vbNullString Then ctl.OnLostFocus = "=fncPintaBotao([" & ctl.Name & "], 0)" 'cor preta
   End Select
Next
For Each rtl In frm.Labels
   Select Case rtl.BackStyle
       Case acLabel
       If ctl.OnGotFocus = vbNullString Then ctl.OnGotFocus = "fncPintaRotulo([" & rtl.Name & "], 1)"
       If ctl.OnLostFocus = vbNullString Then ctl.OnLostFocus = "fncPintaRotulo([" & rtl.Name & "],0)"
   End Select
Next
End Function

Public Function fncPintaCampo(ctl As Control, cor As Byte)

ctl.BackColor = Switch(cor = 0, RGB(255, 255, 255), cor = 1, RGB(255, 253, 185))
If cor = 1 Then ctl.SelStart = Len(ctl.Value & "")
End Function

Public Function fncPintaBotao(ctl As Control, cor As Integer)
ctl.ForeColor = cor
ctl.FontBold = IIf(cor = 0, False, True)
End Function

Public Function fncPintaRotulo(rtl as Label, cor as Byte)
rtl.Backcolor = Switch(cor = 0, RGB(255, 255, 255), cor = 1, RGB(255, 253, 185))
If cor = 1 Then rtl.SelStart = Len(rtl.Value & "")

Tauron, avançou neste assunto?

Desculpem, achei que tinha encerrado este.