Ir para conteúdo
Fórum Script Brasil

Eduardonada

Membros
  • Total de itens

    5
  • Registro em

  • Última visita

Tudo que Eduardonada postou

  1. 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
  2. Muito obrigado amigo, @Alyson Ronnan Martins Fico grato de estar me auxiliando neste processo de aprendizagem! Possuo outras ideias e caso não se sinta incomodado de me auxiliar, ficaria encantado com tamanha compreensão. Acessei a Plan e realizando alguns testes, após cancelar o userform e tentar excluir novamente, o código permite a exclusão do conteúdo da célula, está ação também deveria abrir o userform, não? Trarei outras dúvidas, pode ter certeza! kkkkk Forte abraço...
  3. Boa tarde! kkkk Muito obrigado mesmo. Eu realmente não considerei muitas partes do seu código acima, mas me perdi um pouco onde usar cada uma delas, conseguiria só me esclarecer um pouco melhor? OBS: Não estou conseguindo acessar o link pelo one drive hehe
  4. Opa! Na verdade eu preciso que o meu código identifique o ato de excluir como um gatilho para o Userform, que questiona a exclusão solicitando uma senha para continuar. No entanto, o código não funciona como esperado, por exemplo: Insiro a senha correta e clico em "Excluir" o mesmo funciona porém entra em um loop; Insiro a senha incorreta e clico em "Excluir" o mesmo acusa senha incorreta e apaga a célula (Algo que não deveria); Ao clicar em "Fechar" o mesmo permite a exclusão da célula (Algo que não deveria); Sendo assim de qualquer maneira permitindo a exclusão, precisaria q isso não ocorresse.
  5. Oie! Preciso de uma ajuda em relação a meu código em VBA. Possuo uma planilha em que preciso limitar as pessoas que excluem os itens de um índice, pensei em um UserForm com caixa de texto pedindo uma senha, para deixar registrado quem esta permitindo exclusões, no entanto, não consigo achar uma forma do código entender que o valor texto de uma célula foi excluído (para funcionar como um gatilho do Userform) Atualmente tentei por sinal Key, como sinal do teclado, mas mesmo assim o código não executa a macro como esperado. Código da Planilha Indice: Private Sub Worksheet_Change(ByVal Target As Range) Dim KeyCells As Range Set KeyCells = Me.Range("B5:B" & Me.Cells(Me.Rows.Count, "B").End(xlUp).Row) If Not Application.Intersect(KeyCells, Target) Is Nothing Then If Target.Value = "" And Not Intersect(Target, Me.Range("B:B")) Is Nothing Then senha.Show Application.EnableEvents = False Target.Value = "" Application.EnableEvents = True End If End If End Sub
×
×
  • Criar Novo...