Ir para conteúdo
Fórum Script Brasil
  • 0

Caixa de texto formatação monetária

Eduardonada

Perguntado por Eduardonada,

 Share

Pergunta

Eduardonada

Eduardonada

Postado
Postado

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

 

Link para o comentário
Compartilhar em outros sites

1 resposta a esta questão

Posts Recomendados

  • 0
Alyson Ronnan Martins

Alyson Ronnan Martins

Postado
Postado

Entendi! Parece que o conflito está ocorrendo porque ambos os módulos de classe (TextBoxMoney e ValidadorTextBox) estão tentando controlar eventos das caixas de texto (MSForms.TextBox) e isso está causando interferências.

Para resolver esse problema, você pode mesclar as funcionalidades dos dois módulos de classe em um único módulo, evitando assim os conflitos. Aqui está um exemplo de como você poderia fazer isso:

  

Option Explicit

Private WithEvents txtBox As MSForms.TextBox
Private commaAllowed As Boolean
Private decimalSeparator As String

Public Sub InitializeTextBox(ByVal txt As MSForms.TextBox)
    Set txtBox = txt
    ' Define o separador decimal com base nas configurações regionais
    decimalSeparator = Application.International(xlDecimalSeparator)
    If txtBox.Tag = "Money" Then
        commaAllowed = True
    End If
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

 

Link para o comentário
Compartilhar em outros sites

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.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.

×
 Share
Ir para lista de Perguntas


  • Estatísticas dos Fóruns

    • Tópicos
      152,2k
    • Posts
      651,9k
×
×
  • Criar Novo...