Ir para conteúdo
Fórum Script Brasil

PabloSantos81

Membros
  • Total de itens

    1
  • Registro em

  • Última visita

Sobre PabloSantos81

PabloSantos81's Achievements

0

Reputação

  1. Boa tarde pessoal, sou novo no Fórum, e pela 1ª vez estou tentando criar um formulário, catei um tutorial na net, bem interessante e explicativo, mas na hora de rodar, deu pau... Fiz o formulário, coloquei os campos, alguns dando erros e tal, mas o mais chato é que, quando coloco pra inserir o cadastro, ele dá o erro: Erro em tempo de execução '1004': Erro de definição de aplicativo ou definição de objeto Fim Depurar Ajuda E não sei o que fazer para resolver. Código dentro do VBA Private Sub ComboBox2_Change() End Sub Private Sub CommandButton2_Click() lsLimparTextBox UserForm1 TextBox1.SetFocus End Sub Private Sub CommandButton1_Click() lsInserirTextBox UserForm1, "Cadastro", 1 lsLimparTextBox UserForm1 TextBox1.SetFocus End Sub Private Sub Frame1_Click() End Sub Private Sub TextCodigo_Change() End Sub Private Sub txtDATA1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 'Limita a Qde de caracteres txtDATA1.MaxLength = 8 'para permitir que apenas números sejam digitados If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then KeyAscii = 0 End If End Sub Private Sub txtDATA1_Change() 'Formata : dd/mm/aaaa If Len(txtDATA1) = 2 Or Len(txtDATA1) = 5 Then txtDATA1.Text = txtDATA1.Text & "/" SendKeys "{End}", True End If End Sub Private Sub TextRG_Change() End Sub Private Sub Tipo_Change() End Sub Private Sub Txt_CPF_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 'Limita a Qde de caracteres Txt_CPF.MaxLength = 18 Select Case KeyAscii Case 8, 48 To 57 ' BackSpace e numericos If Len(Txt_CPF) = 3 Or Len(Txt_CPF) = 12 Then Txt_CPF.Text = Txt_CPF.Text & "." SendKeys "{End}", False ElseIf Len(Txt_CPF) = 7 Then Txt_CPF.Text = Txt_CPF.Text & "." ElseIf Len(Txt_CPF) = 11 Then Txt_CPF.Text = Txt_CPF.Text & "-" SendKeys "{End}", False End If Case Else ' o resto é travado KeyAscii = 0 End Select End Sub Private Sub Label1_Click() End Sub Private Sub Label16_Click() End Sub Private Sub OptionButton2_Click() End Sub Private Sub TextBox1_Change() End Sub Private Sub TextBox15_Change() End Sub Private Sub TextBox12_Change() End Sub Private Sub txtCelular_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 'Limita a Qde de caracteres txtCelular.MaxLength = 30 'Formato (xx) xxxxx-xxxx / xxxxx-xxxx If Len(txtCelular) = 0 Then txtCelular.Text = "(" End If If Len(txtCelular) = 3 Then txtCelular.Text = txt2Fone & ") " End If Select Case KeyAscii Case 8, 48 To 57 ' BackSpace e numericos If Len(txtCelular) = 10 Or Len(txtCelular) = 11 Then txtCelular.Text = txtCelular.Text & "-" SendKeys "{End}", False ElseIf Len(txtCelular) = 14 Then txtCelular.Text = txtCelular.Text & " / " ElseIf Len(txtCelular) = 21 Then txtCelular.Text = txtCelular.Text & "-" SendKeys "{End}", False End If Case Else ' o resto é travado KeyAscii = 0 End Select End Sub Private Sub txtDATA_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 'Limita a Qde de caracteres txtDATA.MaxLength = 8 'para permitir que apenas números sejam digitados If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then KeyAscii = 0 End If End Sub Private Sub txtDATA_Change() 'Formata : dd/mm/aa If Len(txtDATA) = 2 Or Len(txtDATA) = 5 Then txtDATA.Text = txtDATA.Text & "/" SendKeys "{End}", True End If End Sub Private Sub txt2Fone_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 'Limita a Qde de caracteres txt2Fone.MaxLength = 26 'Formato (xx) xxxx-xxxx / xxxx-xxxx If Len(txt2Fone) = 0 Then txt2Fone.Text = "(" End If If Len(txt2Fone) = 3 Then txt2Fone.Text = txt2Fone & ") " End If Select Case KeyAscii Case 8, 48 To 57 ' BackSpace e numericos If Len(txt2Fone) = 9 Or Len(txt2Fone) = 10 Then txt2Fone.Text = txt2Fone.Text & "-" SendKeys "{End}", False ElseIf Len(txt2Fone) = 14 Then txt2Fone.Text = txt2Fone.Text & " / " ElseIf Len(txt2Fone) = 21 Then txt2Fone.Text = txt2Fone.Text & "-" SendKeys "{End}", False End If Case Else ' o resto é travado KeyAscii = 0 End Select End Sub Private Sub UserForm_Click() End Sub 'Identifica o tipo do objeto e insere se for um dos tipos definidos Private Sub lsInserir(ByRef lTextBox As Variant, ByVal lSheet As String, ByVal lColunaCodigo As Long, ByVal lUltimaLinha As Long) If (TypeOf lTextBox Is MSForms.TextBox) Or (TypeOf lTextBox Is MSForms.ComboBox) Then Sheets(lSheet).Range(lTextBox.Tag & lUltimaLinha).Value = lTextBox.Text Else If TypeOf lTextBox Is MSForms.OptionButton Then If lTextBox.Value = True Then Sheets(lSheet).Range(lTextBox.Tag & lUltimaLinha).Value = lTextBox.Caption End If End If End If End Sub 'Loop por todos os componentes da tela 'formulario = Nome do UserForm atual 'lSheet = Nome da planilha aonde irão ser inseridos os valores 'lColunaCodigo = Coluna de referência para a inserção dos dados Public Function lsInserirTextBox(formulario As UserForm, ByVal lSheet As String, ByVal lColunaCodigo As Long) Dim controle As Control Dim lUltimaLinhaAtiva As Long lUltimaLinhaAtiva = Worksheets(lSheet).Cells(Worksheets(lSheet).Rows.Count, lColunaCodigo).End(xlUp).Row + 1 For Each controle In formulario.Controls lsInserir controle, lSheet, lColunaCodigo, lUltimaLinhaAtiva Next End Function 'Limpa todos os objetos TextBox da tela Public Function lsLimparTextBox(formulario As UserForm) Dim controle As Control For Each controle In formulario.Controls If TypeOf controle Is MSForms.TextBox Then controle.Text = "" End If Next End Function
×
×
  • Criar Novo...