Este fórum está sendo desativado

[AMORIM123]

Olá, galera.

Bom dia.

No evento initialize do meu "frm_rbpa" tenho a instrução a baixo para que seja feita uma chamada do modo de classe "Classe1" para determinar na propriedade "TAG" (DATE) dos meus txtbox's o formato moeda... exemplo:

Ao tentar digitar R$ 123,33 é visualizado R$ 12,333


Dim cFormat() As New Classe1

Código: Selecionar todos

Private Sub UserForm_Initialize()

Dim Obj         As Integer
Dim TotalObj    As Integer

Call txt_periodo_AfterUpdate
Call limpar
    
    'Pega a quantidade de controles do formulário e armazena na variável
TotalObj = Me.Controls.Count - 1
    
    'Redimensiona a matriz do controle criado para pegar a quantidade de controles existentes
ReDim cFormat(0 To TotalObj)
    
    'Laço para percorrer cada um dos controles existentes no formulário
For Obj = 0 To TotalObj
'Verifica se o controle encontrado possui a TAG "DATE" (definida nas propriedades)
    If Me.Controls(Obj).Tag = "DATE" Then
    'Atribui a matriz do objeto o número do controle encontrado
        Set cFormat(Obj).xFormatDate = Me.Controls(Obj)
    End If
Next
       
End Sub

Já tentei realizar algumas alterações, porém não obtive exito

Em anexo a planilha pra ajudar a me ajudar vlw
aquém puder ajudar...muito obrigado pelo tempo e atenção

[babdallas]

Veja se seu código usa esta ideia e tente ver o que pode estar diferente.

http://excelevba.com.br/formato-moeda-n ... to-digita/

[AMORIM123]

e ai babdallas..

o cód que estou utilizando tem origem nesse cód que sitaste, porém alterações visavam uma compactação da quantidade de linhas de cód, uma vez que, terei que abrir um "Private" para cada txtbox...tornava o cód muito extenso e repetitivo...por isso optei por essa alteração...houve esse problema... se puder dar uma análisada..agradeço

[babdallas]

Vou pedir um favor. Anexa um arquivo sem ocultar e desocultar barras de rolagem, etc e sem ocultar a aplicação, por favor. Deixa isso para sua aplicação final. É ruim ter que ficar ajustando meu Excel depois que abro seu arquivo.

[babdallas]

Desabilitei as subrotinas de ocultar e o código de deixar o Excel oculto para que não haja dificuldade para outros baixarem a planilha e testar.
Você pegou o código da internet, criou um evento Keypress em uma classe. Só mudei para um evento Change e deixei o código em um subrotina separada, chamando esta subrotina de formatar moeda no evento Change.

[AMORIM123]

havia esquecido pop-up...na extremidade inferior esquerda ao dar um click ou duploclick o modo pop-up do form é encerrado.

...quanto à alteração implementada... é ótima..pensei no "change" também...mas sabe como é iniciante não tive segurança...mas muito obrigado!

Da forma que tá é ideal para quem procura deixar seus txtbox's com formato moeda sem ter que escrever uma linha de código para cada txtbox....da forma linkada.. que o Bruno Sobral compilou é show, mas qnd vamos trabalhar com muito form's ..e muitos txtbox ai fica, além de feio para se ler..muito trabalhoso..sem conta a lentidão que pode ocasionar...desta forma ficou show.

Para um entendimento melhor de quem vir a procura de uma solução parecida, segue a síntexe:


1 - Abra um módulo de classe e declare:

Código: Selecionar todos

Public WithEvents xFormatDate As MSForms.TextBox

2- No mesmo módulo de classe cole

Código: Selecionar todos

Private Sub xFormatDate_Change()
    Call FormataMoeda(xFormatDate.Value)
End Sub

Private Sub FormataMoeda(valor As Variant)
   'Dim valor As String
    Dim numPonto As String
    Dim numVirgula As String
    valor = xFormatDate.Value
    If IsNumeric(valor) Then
        If InStr(1, valor, "-") >= 1 Then valor = Replace(valor, "-", "") 'retira sinal negativo
        If InStr(1, valor, ",") >= 1 Then valor = CDbl(Replace(valor, ",", "")) 'retirar a virgula
        If InStr(1, valor, ".") >= 1 Then valor = Replace(valor, ".", "") 'para trabalhar melhor retiramos ponto
        Select Case Len(valor) 'verifica casas para inserção de ponto
            Case 1
                numPonto = "00" & valor
            Case 2
                numPonto = "0" & valor
            Case 6 To 8
                numPonto = Left(valor, Len(valor) - 5) & "." & Right(valor, 5)
            Case 9 To 11
                numPonto = inserirPonto(8, valor)
            Case 12 To 14
                numPonto = inserirPonto(11, valor)
            Case Else
                numPonto = valor
        End Select
        numVirgula = Left(numPonto, Len(numPonto) - 2) & "," & Right(numPonto, 2)
        xFormatDate.Value = numVirgula
    Else
        If valor = "" Then Exit Sub
        MsgBox "Número invalido", vbCritical, "Caracter Invalido"
        Exit Sub
    End If
End Sub

Function inserirPonto(inicio, valor)
    I = Left(valor, Len(valor) - inicio)
    M1 = Left(Right(valor, inicio), 3)
    M2 = Left(Right(valor, 8), 3)
    F = Right(valor, 5)
    If (M2 = M1) And (Len(valor) < 12) Then
        inserirPonto = I & "." & M1 & "." & F
    Else
        inserirPonto = I & "." & M1 & "." & M2 & "." & F
    End If
End Function

3 - Ainda no módulo de classe, chame o evento anterior dentro do procedimento abaixo:

Código: Selecionar todos

Private Sub xFormatDate_Change()
    Call FormataMoeda(xFormatDate.Value)
End Sub

4 - Em seguida no módulo de cada form:

Código: Selecionar todos

Private Sub UserForm_Initialize()
    Dim Obj As Integer
    Dim TotalObj As Integer
    Dim i As Integer, l As Integer, TB
    
    
    'Pega a quantidade de controles do formulário e armazena na variável
    TotalObj = Me.Controls.Count - 1
    
    'Redimensiona a matriz do controle criado para pegar a quantidade de controles existentes
    ReDim cFormat(0 To TotalObj)
    
    'Laço para percorrer cada um dos controles existentes no formulário
    For Obj = 0 To TotalObj
        'Verifica se o controle encontrado possui a TAG "DATE" (definida nas propriedades)
        If Me.Controls(Obj).Tag = "DATE" Then
            'Atribui a matriz do objeto o número do controle encontrado
            Set cFormat(Obj).xFormatDate = Me.Controls(Obj)
        End If
        Next
End Sub

5 - Pronto! Nas propriedade de cada txtbox, em "tag" basta digitar DATE ...só testar

Vlw...babdallas