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) = 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) = 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
Pergunta
PabloSantos81
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
Link para o comentário
Compartilhar em outros sites
0 respostass a esta questão
Posts Recomendados
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.