Ir para conteúdo
Fórum Script Brasil
  • 0

Criando formulário no Excel com VBA, mas dá erro 1004


PabloSantos81

Pergunta

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

Até agora não há respostas para essa pergunta

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.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,3k
×
×
  • Criar Novo...