Textbox em vba Excel...Formato de moeda...

Question

Bom dia a todos.

Estou tendo um problema em configurar um TextBox no Vba Excel para formato de moeda.

Estou querendo a seguinte formatação final. Ex.: R$ 1.250,35 ( Um mil duzentos e cinquenta reais e trinta e cinco centavos ).

Segue abaixo o script no vba excel....

Private Sub optValor_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   
    If IsNumeric(Me.optValor) = True Then
    Me.optValor = Replace(Me.optValor, ",", "")
    Me.optValor = Format(Me.optValor / 100, "R$ #,##0.00")

    End If

    If KeyAscii = vbKeyReturn Or KeyAscii = vbKeyBack Then Exit Sub

    If KeyAscii < vbKey0 Or KeyAscii > vbKey9 Then

    KeyAscii = 0

    ElseIf KeyAscii <> vbKeyDecimal Then

    End If

End Sub

Entretanto, o valor final me retorna sempre com 3 ( tres ) digitos apos a virgula.

Agradesço a todos.

Answer 1

Bom dia!!!

Tente assim.....Me.optValor = Format(Me.optValor / 100, "R$ #,0.#0") 

Att..

---

zinho

Answer 2

Bom dia rodei muito a internet atraz dessa solução mas nada eu encontrei, então como sou programador de outra linguagem tenho alguma noção de possiveis soluções, esta foi a que encontrei.

O que eu faço é simplesmente pegando do textbox os valores que eu quero e colocando a virgula onde eu quero, a função MID é parecida com a função substr() do clipper e outras linguagens.

Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
TextBox1.MaxLength = 20
'MsgBox (Len(TextBox1))
'MsgBox (TextBox1)
Select Case Len(TextBox1.Text)
Case Is = 2
'R$ 1,00
TextBox1.Text = "R$ " + Mid(TextBox1, 1, 1) + "," + Mid(TextBox1, 2, 1)
Case Is = 7
'R$ 10,00
TextBox1.Text = Mid(TextBox1, 1, 4) + Mid(TextBox1, 6, 1) + "," + Mid(TextBox1, 7, 1)
Case Is = 8
'R$ 100,00
TextBox1.Text = Mid(TextBox1, 1, 5) + Mid(TextBox1, 7, 1) + "," + Mid(TextBox1, 8, 1)
Case Is = 9
'R$ 1.000,00
TextBox1.Text = Mid(TextBox1, 1, 4) + "." + Mid(TextBox1, 5, 2) + Mid(TextBox1, 8, 1) + "," + Mid(TextBox1, 9, 1)
Case Is = 11
'R$ 10.000,00
TextBox1.Text = Mid(TextBox1, 1, 4) + Mid(TextBox1, 6, 1) + "." + Mid(TextBox1, 7, 2) + Mid(TextBox1, 10, 1) + "," + Mid(TextBox1, 11, 1)
Case Is = 12
'R$ 100.000,00
TextBox1.Text = Mid(TextBox1, 1, 5) + Mid(TextBox1, 7, 1) + "." + Mid(TextBox1, 8, 2) + Mid(TextBox1, 11, 1) + "," + Mid(TextBox1, 12, 1)
Case Is = 13
'R$ 1.000.000,00
TextBox1.Text = Mid(TextBox1, 1, 4) + "." + Mid(TextBox1, 5, 2) + Mid(TextBox1, 8, 1) + "." + Mid(TextBox1, 9, 2) + "," + Mid(TextBox1, 13, 2) + Mid(TextBox1, 14, 1)

End Select

End Sub

É isso só postei por que não encontrei a solução tive que fazer essa "gambiarra".

Answer 3

É curioso a forma com a qual você nomeou seu controle: optValor. Se ele é uma caixa de texto, por que não o chamou de txtValor? optValor, pra mim, representaria um botão de opção (Option Button). Fique atento ao prefixo de nomenclatura de seus controles para facilitar a leitura do seu código, e não confundir.

---

Outra: embora representar moeda no formato R$ 0.000,00 seja visualmente melhor, não acho que valha a pena gastar tempo programando rotinas que transformar um valor digitado num valor de exibição.

Temos que ter em mente que o valor entrado pelo usuário é uma coisa, e o exibido é outro. Não vale a pena misturar as duas coisas, o esforço não compensa. O ideal é você simplesmente criar uma rotina de validação num botão de comando OK, por exemplo, que verifique se a caixa de texto possui um número ou não.

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 4

Bem, a intenção foi dar uma solução a questão que não foi dada e somar junto ao forum como não disse não sou programador vba e sim clipper/harbour. O codigo funciona perfeitamente, independente e de nomes isso pra mim é coisa q não tem importância é como uma variável vc da o nome que quiser desde q saiba como usar ela vai funcionar. Me desculpe se fiz mal.

Answer 5

Bruno,

Me desculpe se me expressei mal. Só para esclarecer: parabéns pelo código e obrigado pela contribuição.

O que escrevi não foi uma crítica a seu código ou quem cria validações em tempo de digitação em formulários.

Apenas levantei uma questão de praticidade em programação, em algo que acredito: não acho que compense criar validações desse tipo em formulários, em cada uma das caixas de texto. Acho mais prático criar uma função de validação no evento de clicar em OK num botão, por exemplo.

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 6

Prezados,

Precisei e não encontrei a resposta, então resolvi fazer do meu jeito.

Talvez exista uma forma mais simples para resolver esta situação, mas aqui vai a minha contribuição caso mais alguem precise daqui pra frente.

Private Sub TextBox1_Enter()

    If TextBox1.Text = "" Then
        TextBox1.Text = "0,00"
    End If

End Sub

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If KeyAscii > 47 And KeyAscii < 58 Then

        TextBox1.Text = Replace(TextBox1.Text, ",", "")
        TextBox1.Text = Replace(TextBox1.Text, ".", "")
       
        If Mid(TextBox1.Text, 1, 1) = "0" Then
            TextBox1.Text = Mid(TextBox1.Text, 2, Len(TextBox1.Text))
        End If
       
        TextBox1.Text = Mid(TextBox1.Text, 1, Len(TextBox1.Text) - 1) & "," & Mid(TextBox1.Text, Len(TextBox1.Text), 2)
        a = InStr(1, TextBox1.Text, ",", vbTextCompare)
        b = Mid(TextBox1.Text, 1, a - 1)
       
        For x = 1 To Len(b)
            cont = cont + 1
            c = Mid(b, Len(b) - x + 1, 1) & c
            If cont = 3 Then
                If Len(b) > 3 Then
                    c = "." & c
                    cont = 0
                End If
            End If
        Next x
       
        If Mid(c, 1, 1) = "." Then
            c = Mid(c, 2, Len(c))
        End If
       
        TextBox1.Text = c & Mid(TextBox1.Text, Len(TextBox1.Text) - 1, 2)
       
    Else
   
        KeyAscii = 0
       
    End If

End Sub

'Parte importante que eu não havia percebido.

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 8 Or KeyCode = 46 Then
        TextBox1.Text = Replace(TextBox1.Text, ",", "")
        TextBox1.Text = Replace(TextBox1.Text, ".", "")
        If Len(TextBox1.Text) > 3 Then
            TextBox1.Text = Mid(TextBox1.Text, 1, Len(TextBox1.Text) - 2) & "," & Mid(TextBox1.Text, Len(TextBox1.Text) - 1, 2)
        Else
       
            If Len(TextBox1.Text) = 3 Then
                TextBox1.Text = Mid(TextBox1, 1, 1) & "," & Mid(TextBox1.Text, 2, 2)
            Else
           
                If Len(TextBox1.Text) = 2 Then
                    TextBox1.Text = "0," & Mid(TextBox1.Text, 1, 2)
                End If
               
            End If
           
        End If
        a = InStr(1, TextBox1.Text, ",", vbTextCompare)
        b = Mid(TextBox1.Text, 1, a - 1)
       
        For x = 1 To Len(b)
            cont = cont + 1
            c = Mid(b, Len(b) - x + 1, 1) & c
            If cont = 3 Then
                If Len(b) > 3 Then
                    c = "." & c
                    cont = 0
                End If
            End If
        Next x
       
        If Mid(c, 1, 1) = "." Then
            c = Mid(c, 2, Len(c))
        End If
       
        TextBox1.Text = c & Mid(TextBox1.Text, Len(TextBox1.Text) - 2, 3)
End If
End Sub

Abraços

Answer 7

Olá a todos. Estou iniciando neste Fórum e gostaria de postar uma solução para o caso.

Private Sub TxtEventos_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

            Dim zTemp as String

            TxtEventos.TextAlign = fmTextAlignRight
            If IsNumeric(Chr(KeyCode)) Or KeyCode = 8 Then
                If TxtEventos.Text <> "" Then
                    zTemp = TxtEventos.Text & IIf(KeyCode <> 8, Chr(KeyCode), "")
                    zTemp = Right(zTemp, Len(zTemp) - 2)
                    zTemp = Replace(zTemp, ".", "")
                    zTemp = Replace(zTemp, ",", "")
                    If KeyCode = 8 Then
                        If Len(zTemp) > 3 Then
                            zTemp = Left(zTemp, Len(zTemp) - 1)
                        Else
                            zTemp = "0" & Left(zTemp, Len(zTemp) - 1)
                        End If
                    End If
                    zTemp = Left(zTemp, Len(zTemp) - 2) & "." & Right(zTemp, 2)
                Else
                    zTemp = "0.0" & IIf(KeyCode <> 8, Chr(KeyCode), "0")
                End If
                TxtEventos.Text = Format(Val(zTemp), "R$###,##0.00")
                KeyCode = 0
            Else
                If KeyCode <> 13 And KeyCode <> 9 And KeyCode <> 40 And KeyCode <> 38 Then KeyCode = 0
            End If

End Sub