Bom dia pessoal! Estou com uma tremenda dúvida e com um constante problema em uma planilha, preciso formatar todas as caixas de textos que possuírem "Money" na região Tag!
Mas eu já estou a alguns dias tentando mesclar os dois módulos de classe e não consigo, um sempre conflita com o outro.
Vou lhes enviar
'User Form
Private CollecaoTextBoxes As Collection
Private Sub TxtValor_Change()
If Len(Me.TxtValor.value) = 0 Then
Me.LblValor.Caption = "Valor"
Me.LblValor.Top = 98
Me.LblValor.ForeColor = RGB(116, 116, 116)
Else
Me.LblValor.Caption = "Valor"
Me.LblValor.Top = 80
Me.LblValor.ForeColor = RGB(47, 62, 255)
End If
End Sub
Private Sub TxtPgt_Change()
If Len(Me.TxtPgt.value) = 0 Then
Me.LblPgt.Caption = "Prazos"
Me.LblPgt.Top = 98
Me.LblPgt.ForeColor = RGB(116, 116, 116)
Else
Me.LblPgt.Caption = "Prazos"
Me.LblPgt.Top = 80
Me.LblPgt.ForeColor = RGB(47, 62, 255)
End If
End Sub
' Módulo de Formulário
Private Sub UserForm_Initialize()
InitializeTextBoxes Me
Set CollecaoTextBoxes = New Collection
Dim ctrl As Control
Dim validador As ValidadorTextBox
For Each ctrl In Me.Controls
If TypeName(ctrl) = "TextBox" Then
Set validador = New ValidadorTextBox
validador.Initialize ctrl
CollecaoTextBoxes.Add validador
End If
Next ctrl
End Sub
'Módulo Comum Módulo 1
Option Explicit
Private colTextBoxes As Collection
Public Sub InitializeTextBoxes(ByVal frm As Object)
Dim ctrl As Control
Set colTextBoxes = New Collection
' Loop através de todos os controles no formulário
For Each ctrl In frm.Controls
If TypeName(ctrl) = "TextBox" Then
' Instancia o módulo de classe para cada TextBox
Dim clsTextBox As TextBoxMoney
Set clsTextBox = New TextBoxMoney
Set clsTextBox.TextBox = ctrl
colTextBoxes.Add clsTextBox
End If
Next ctrl
End Sub
' Módulo de classe TextBoxMoney
Option Explicit
Private WithEvents txtBox As MSForms.TextBox
Private commaAllowed As Boolean
Public decimalSeparator As String
Private Sub txtBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
decimalSeparator = Application.International(xlDecimalSeparator)
If InStr(1, txtBox.Tag, "Teste", vbTextCompare) > 0 Then
If Not (IsNumeric(Chr(KeyAscii)) Or KeyAscii = 44 Or KeyAscii = 8 And Chr(KeyAscii) <> decimalSeparator) Then ' Permite apenas números e a vírgula
KeyAscii = 0
ElseIf KeyAscii = 44 Then ' Verifica se é uma vírgula
If Not commaAllowed Then ' Permite apenas uma vírgula e apenas se não houver outra vírgula já inserida
KeyAscii = 0
Else
commaAllowed = False ' Desabilita a inserção de mais vírgulas
End If
ElseIf KeyAscii = 8 Then ' Verifica se é o caractere backspace
If Right(txtBox.text, 1) = "," Then ' Permite a exclusão de caracteres
commaAllowed = True ' Permite a inclusão de uma nova vírgula se a última entrada for uma vírgula
End If
ElseIf InStr(txtBox.text, ",") > 0 Then
Dim afterComma As String ' Verifica se há uma vírgula na string
afterComma = Split(txtBox.text, ",")(1)
If Len(afterComma) >= 2 Then ' Limita a inserção de caracteres após a vírgula a dois dígitos
KeyAscii = 0
End If
Else
' Permitir a adição de uma nova vírgula se não houver vírgula na string
commaAllowed = True
End If
End If
End Sub
Public Property Set TextBox(ByVal txt As MSForms.TextBox)
Set txtBox = txt
End Property
'Módulo de Classe ValidadorTextBox
Option Explicit
Private commaAllowed As Boolean
Private WithEvents txtBox As MSForms.TextBox
Private decimalSeparator As String
Public Sub Initialize(txt As MSForms.TextBox)
Set txtBox = txt
' Define o separador decimal com base nas configurações regionais
decimalSeparator = Application.International(xlDecimalSeparator)
End Sub
Private Sub txtBox_Change()
If txtBox.Tag = "Money" Then
Dim valor As String
Dim parteInteira As String
Dim parteDecimal As String
Dim ponto As Long
valor = txtBox.text
' Verifica se o valor começa com "R$ "
If Left(valor, 3) = "R$ " Then
' Remove o prefixo "R$ "
valor = Mid(valor, 4)
End If
' Remove o separador de milhares atual, se houver
valor = Replace(valor, ".", "")
' Verifica se o separador decimal é uma vírgula (configuração regional)
If decimalSeparator = "," Then
' Substitui vírgulas por pontos para garantir a uniformidade
valor = Replace(valor, ",", ".")
End If
' Divide o valor em parte inteira e parte decimal
ponto = InStr(valor, ".")
If ponto > 0 Then
parteInteira = Left(valor, ponto - 1)
parteDecimal = Mid(valor, ponto + 1)
Else
parteInteira = valor
parteDecimal = ""
End If
' Adiciona pontos de demarcação para milhares
parteInteira = Format(parteInteira, "#,##0")
' Reconstroi o valor completo
valor = parteInteira
If Len(parteDecimal) > 0 Then
valor = valor & decimalSeparator & parteDecimal
End If
' Verifica se o valor numérico foi removido
If valor = "" Then
' Remove o prefixo "R$ " se o valor for vazio
txtBox.text = ""
Else
' Adiciona o prefixo "R$ "
valor = "R$ " & valor
' Atualiza o valor na caixa de texto
txtBox.text = valor
End If
' Move o cursor para o final do texto
txtBox.SelStart = Len(txtBox.text)
End If
End Sub
Public Property Set TextBox(ByVal txt As MSForms.TextBox)
Set txtBox = txt
End Property
Pergunta
Eduardonada
Bom dia pessoal! Estou com uma tremenda dúvida e com um constante problema em uma planilha, preciso formatar todas as caixas de textos que possuírem "Money" na região Tag!
Mas eu já estou a alguns dias tentando mesclar os dois módulos de classe e não consigo, um sempre conflita com o outro.
Vou lhes enviar
Link para o comentário
Compartilhar em outros sites
1 resposta a esta questão
Posts Recomendados
Participe da discussão
Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.