Excel Excel, VBA, Como executar um mesmo comando em todas as TextBox

[Patricia Senatore Ribeiro]

Bom dia, mais uma vez venho pedir ajuda. Tenho uma UserForm onde insiro datas nas TextBox1 e nelas aparecem as barras automaticamente, para isso estou usando este código:

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)


    If KeyAscii < 48 Or KeyAscii > 57 Then 'Não permite inserir letras
        KeyAscii = 0
    Else
        If Len(TextBox1) = 2 Then  'Len retorna a quantidade de caracteres
            TextBox1 = TextBox1 & "/"
        End If
        If Len(TextBox1) = 5 Then
            TextBox1 = TextBox1 & "/"
        End If
    End If

End Sub

 

O problema é que eu tenho 12 TextBox então teria que inserir uma sub dessa para cada um. Tem algum jeito de eu fazer somente isso somente 1 vez para funcionar em todas as TextBox?

[Basole]

Se quer fazer isso dinamicamente falando, ou seja se de 12, aumentar a quantidade de textbox para 24, sem precisar mexer no código, segue sugestão:

 

Crie um modulo de classe, e renomeie como SuaClasse e cole o codigo abaixo:

Option Explicit

Public WithEvents TextGroup As MSForms.TextBox

Private Sub TextGroup_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    
            TextGroup.MaxLength = 10 ' limita a qtd max. de caracteres => 01/01/2018

    If KeyAscii < 48 Or KeyAscii > 57 Then 'Não permite inserir letras
    KeyAscii = 0
Else
    If Len(TextGroup) = 2 Then  'Len retorna a quantidade de caracteres
    TextGroup = TextGroup & "/"
End If
If Len(TextGroup) = 5 Then
    TextGroup = TextGroup & "/"
End If
End If

End Sub

E no seu userform que contem as textbox (data), acrescente o código abaixo:

 

Option Explicit

Public WithEvents TextGroup As MSForms.TextBox

Dim TextBoxes() As New SuaClasse

Private Sub UserForm_Initialize()
    
    Call CarregaSuaClasseTextbox ' Chama a sub que configura os textbox, adicionando a classe
    
End Sub

Sub CarregaSuaClasseTextbox()
    Dim ctl As MSForms.Control
    Dim i!
    
    i = 1
    
    For Each ctl In Me.Controls
        
        If TypeName(ctl) = "TextBox" Then
            ReDim Preserve TextBoxes(1 To i)
            Set TextBoxes(i).TextGroup = ctl
            i = i + 1
        End If
        
    Next ctl    

End Sub

 

* Desta forma em todos os textbox aparecerão as barras automaticamente, ao digitar os numeros

 

Uma outra opção seria, colocar um form/calendário, que abre como um pop-up para o usuário clicar para inserir uma data. Desta forma evitará erros na formatação ou data inválida do tipo: 30/02/2018.

 

 

 

[Patricia Senatore Ribeiro]

Funcionou perfeitamente! Mais uma vez muito obrigada!!!

[Silvio Alves Nitro]

Boa tarde, o exemplo a cima resolveu um problema meu, no entanto como posso fazer para que a função só seja aplicado entre a textbox30 e a textbox50? no exemplo a cima aplica a todas as textbox do userform.

obrigado

[Basole]

@Silvio Alves Nitro não sei  como está seu cenário.

Mas experimente colocar uma condição para carregar as textbox.

Ex.

 

If vba.right(ctl.name, 2) >29 And < 51 then 

Set TextBoxes(i).TextGroup = ctl

i = i + 1

End if 

 

 

 

 

 

 

 

[Silvio Alves Nitro]

@Basole o meu senario e praticamente o que você indicou no inicio deste poste, e esta a funcionar bem 

o meu único problema e que tenho 900 textbox e queria que a funçao fosse aplicada apenas da textbox32 ate a textbox800

porque da forma que tenho está a a funcionar mas nas outras textbox também esta a aplicar a função

muito obrigado

 

(MODULO CLASSE)

Option Explicit

Public WithEvents TextGroup As MSForms.TextBox

Private Sub TextGroup_Change()
If TextGroup = "A" Then
               TextGroup.BackColor = &HFF&

                ElseIf TextGroup = "B" Then
                TextGroup.BackColor = &HFF00&
                Else
                TextGroup.BackColor = &H80000005
                End If

End Sub

 

'-----------------------------------------------------------------

Sub CarregaSuaClasseTextbox()
    

    
    Dim ctl As MSForms.control
    Dim i!
    
    i = 1
    
    For Each ctl In Me.Controls
    
        If TypeName(ctl) = "TextBox" Then

           ReDim Preserve TextBoxes(1 To i)

            Set TextBoxes(i).TextGroup = ctl

            i = i + 1
        End If

    Next ctl

'-----------------------------------------------------------

Sub UserForm_Initialize()
Call CarregaSuaClasseTextbox ' Chama a sub que configura os textbox, adicionando a classe

End  Sub

 

[Basole]

@Silvio Alves Nitro mas você tentou adaptar o exemplo que postei ? 

 

[Silvio Alves Nitro]

@Basole Sim tentei mas não consegui

[Midori]

5 horas atrás, Silvio Alves Nitro disse:

o meu único problema e que tenho 900 textbox e queria que a funçao fosse aplicada apenas da textbox32 ate a textbox800

Para aplicar o evento apenas nesses controles é só extrair o valor numérico do nome do TextBox e fazer a comparação do intervalo, p.ex,

 

Numero = Replace(ctl.Name, "TextBox", "")
If IsNumeric(Numero) Then
    If Numero >= 32 And Numero <= 800 Then
    ...
    End If
End If

 

Esse é o critério para a atribuição da coleção de TextBoxes.

[Silvio Alves Nitro]

2 horas atrás, Midori disse:

Para aplicar o evento apenas nesses controles é só extrair o valor numérico do nome do TextBox e fazer a comparação do intervalo, p.ex,

 

Numero = Replace(ctl.Name, "TextBox", "")
If IsNumeric(Numero) Then
    If Numero >= 32 And Numero <= 800 Then
    ...
    End If
End If

 

Esse é o critério para a atribuição da coleção de TextBoxes.

Desde já agradeço a ajuda, podia me indicar um pouco mais onde colocar esse código ? já testei de algumas formas mas sem sucesso, dá-me  sempre erro e pede -me uma variável para numero. Peço desculpa pelo incomodo, obrigado

[Basole]

@Silvio Alves Nitro 

Citação

....... como posso fazer para que a função só seja aplicado entre a textbox30 e a textbox50? no exemplo a cima aplica a todas as textbox do userform.

 

No seu primeiro post voce afirmou que queria aplicar entre a textbox 30 a 50 

 

Na minhas resposta com pequena correção atenderia.

   

If VBA.Right(ctl.Name, 2) > 29 And VBA.Right(ctl.Name, 2) < 51 Then
   Set TextBoxes(i).TextGroup = ctl
  i = i + 1
End If

 

 

Já com a sua nova solicitacao e a colaboracao do colega @Midori 

fica assim o codigo no userfom.... declarando a variavel Numero

 

Option Explicit

Public WithEvents TextGroup As MSForms.TextBox

Dim TextBoxes() As New SuaClasse

Sub CarregaSuaClasseTextbox() 
    
    Dim ctl As MSForms.Control
    Dim i!
    Dim Numero
    
    i = 1
    
    For Each ctl In Me.Controls
    
        If TypeName(ctl) = "TextBox" Then

           ReDim Preserve TextBoxes(1 To i)
             
           Numero = Replace(ctl.Name, "TextBox", "")
            If IsNumeric(Numero) Then
             
              If Numero >= 32 And Numero <= 800 Then

                Set TextBoxes(i).TextGroup = ctl

                 i = i + 1
                 
              End If
              
            End If
                       
     End If
        
   Next ctl
 End Sub


Sub UserForm_Initialize()

Call CarregaSuaClasseTextbox

End Sub

 

[Silvio Alves Nitro]

Muito obrigado  Basole

Muito obrigado Midori

 

Com os vossos códigos e explicações consegui resolver o problema.

Muito obrigado aos dois