Página 1 de 1

Re: Erro em tempo de execução [MAIS OU MENOS RESVOLIDO]

Enviado: Sáb Jan 18, 2020 10:13 am
por tarefa
Bom dia.
Estou utilizando o aplicativo de cadastro em VBA no Microsoft Excel.
O formulario funciona apos atualização do Office
O botão de pesquisa parou de funcionar
Aparece o Erro:
"Erro em tempo de Execução '424"; O objeto é obrigatorio".
A linha é:

Private Sub btnPesquisar_Click()
frmPesquisa.Show (aparece em amarelo)
End Sub

Não sei como corrigir
Alguem pode ajudar, pois não tenho conhecimento suficiente.

Re: Erro em tempo de execução

Enviado: Sáb Jan 18, 2020 6:50 pm
por webmaster
O erro está no próprio frmPesquisa. O VBA não é esperto suficiente para mostrar isso. Se o frmPesquisa tiver o Initialize (e deve ter), coloque um ponto de interrupção nele e provavelmente encontrará o erro.

Re: Erro em tempo de execução

Enviado: Seg Jan 20, 2020 4:34 pm
por tarefa
Desculpe ainda me falta o conhecimento necessário. Pode me ajudar??

Código: Selecionar todos

'Modelo de Aplicativo de Cadastro em VBA no Microsoft Excel
'Autor: Tomás Vásquez
'http://www.tomasvasquez.com.br
'http://tomas.vasquez.blog.uol.com.br
'março de 2008

'Adaptação Mauro Coutinho com LISTVIEW
'Julho de 2011

Option Explicit

Const colCodigoDoFornecedor As Integer = 1
Const colTitulo As Integer = 2
Const colAtor As Integer = 3
Const colAtor2 As Integer = 4
Const colDiretor1 As Integer = 5
Const colTipo As Integer = 6
Const colGenero As Integer = 7
Const colAno As Integer = 8
Const colArquivo As Integer = 9
Const colTelefone As Integer = 10
Const colFax1 As Integer = 11
Const colFax As Integer = 12
Const colHomePage As Integer = 13
Const indiceMinimo As Byte = 2
Const corDisabledTextBox As Long = -2147483633
Const corEnabledTextBox As Long = -2147483643
Const nomePlanilhaCadastro As String = "Fornecedores"

Private wsCadastro As Worksheet
Private wbCadastro As Workbook
Private indiceRegistro As Long

Private Sub btnCancelar_Click()
    btnOK.Enabled = False
    btnCancelar.Enabled = False
    Call DesabilitaControles
    Call CarregaDadosInicial
    Call HabilitaBotoesAlteracao
End Sub

Private Sub btnOK_Click()
    Dim proximoId As Long

    'Altera
    If optAlterar.Value Then
        Call SalvaRegistro(CLng(txtCodigoFornecedor.Text), indiceRegistro)
        lblMensagem.Caption = "Registro salvo com sucesso"
    End If
    'Novo
    If optNovo.Value Then
        proximoId = PegaProximoId
        'pega a próxima linha
        Dim proximoIndice As Long
        'atualiza o arquivo para pegar o próximo registro atualizado
        Call AtualizarArquivo(False)
        proximoIndice = wsCadastro.UsedRange.Rows.Count + 1
        Call SalvaRegistro(proximoId, proximoIndice)
        txtCodigoFornecedor = proximoId
        lblMensagem.Caption = "Registro salvo com sucesso"
    End If
    'Excluir
    If optExcluir.Value Then
        Dim result As VbMsgBoxResult
        result = MsgBox("Deseja excluir o registro nº " & txtCodigoFornecedor.Text & " ?", vbYesNo, "Confirmação")

        If result = vbYes Then
            'abre o arquivo para escrita
            Call AtualizarArquivo(False)
            wsCadastro.Range(wsCadastro.Cells(indiceRegistro, colCodigoDoFornecedor), wsCadastro.Cells(indiceRegistro, colCodigoDoFornecedor)).EntireRow.Delete
            'salva
            wbCadastro.Save
            'abre somente leitura
            Call AtualizarArquivo(True)
            Call CarregaDadosInicial
            lblMensagem.Caption = "Registro excluído com sucesso"
        End If
    End If

    Call HabilitaBotoesAlteracao
    Call DesabilitaControles

End Sub

Private Sub btnPesquisar_Click()

frmPesquisa.Show
  
End Sub

Private Sub optAlterar_Click()
    If txtCodigoFornecedor.Text <> vbNullString And txtCodigoFornecedor.Text <> "" Then
        Call HabilitaControles
        Call DesabilitaBotoesAlteracao
        'dá o foco ao primeiro controle de dados
        txtTitulo.SetFocus
    Else
        lblMensagem.Caption = "Não há registro a ser alterado"
    End If
End Sub

Private Sub optExcluir_Click()
    If txtCodigoFornecedor.Text <> vbNullString And txtCodigoFornecedor.Text <> "" Then
        Call DesabilitaBotoesAlteracao
        lblMensagem.Caption = "Modo de exclusão. Confira o dados do registro antes de excluí-lo"
    Else
        lblMensagem.Caption = "Não há registro a ser excluído"
    End If
End Sub

Private Sub optNovo_Click()
    Call LimpaControles
    Call HabilitaControles
    Call DesabilitaBotoesAlteracao
    'dá o foco ao primeiro controle de dados
    txtTitulo.SetFocus
End Sub

Private Sub UserForm_Initialize()
    
    Call DefinePlanilhaDados
    Call HabilitaBotoesAlteracao
    Call CarregaDadosInicial
    Call DesabilitaControles
End Sub

Private Sub btnAnterior_Click()
    If indiceRegistro > indiceMinimo Then
        indiceRegistro = indiceRegistro - 1
    End If
    If indiceRegistro > 1 Then
        Call CarregaRegistro
    End If
End Sub

Private Sub btnPrimeiro_Click()
    indiceRegistro = indiceMinimo
    If indiceRegistro > 1 Then
        Call CarregaRegistro
    End If
End Sub

Private Sub btnProximo_Click()
    If indiceRegistro < wsCadastro.UsedRange.Rows.Count Then
        indiceRegistro = indiceRegistro + 1
    End If
    If indiceRegistro > 1 Then
        Call CarregaRegistro
    End If
End Sub

Private Sub btnUltimo_Click()
    indiceRegistro = wsCadastro.UsedRange.Rows.Count
    If indiceRegistro > 1 Then
        Call CarregaRegistro
    End If
End Sub

Private Sub CarregaDadosInicial()
    indiceRegistro = 2
    Call CarregaRegistro
End Sub

Private Sub CarregaRegistro()
'carrega os dados do primeiro registro
    With wsCadastro
        If Not IsEmpty(.Cells(indiceRegistro, colCodigoDoFornecedor)) Then
            Me.txtCodigoFornecedor.Text = .Cells(indiceRegistro, colCodigoDoFornecedor).Value
            Me.txtTitulo.Text = .Cells(indiceRegistro, colTitulo).Value
            Me.txtAtor1.Text = .Cells(indiceRegistro, colAtor).Value
            Me.txtAtores.Text = .Cells(indiceRegistro, colAtor2).Value
            Me.txtDiretor1.Text = .Cells(indiceRegistro, colDiretor1).Value
            Me.txtTipo.Text = .Cells(indiceRegistro, colTipo).Value
            Me.txtGenero.Text = .Cells(indiceRegistro, colGenero).Value
            Me.txtAno.Text = .Cells(indiceRegistro, colAno).Value
            Me.txtArquivo.Text = .Cells(indiceRegistro, colArquivo).Value
            Me.txtTelefone.Text = .Cells(indiceRegistro, colTelefone).Value
            Me.txtFax1.Text = .Cells(indiceRegistro, colFax1).Value
            Me.txtFax.Text = .Cells(indiceRegistro, colFax).Value
            Me.txtHomePage.Text = .Cells(indiceRegistro, colHomePage).Value
        End If
    End With

    Call AtualizaRegistroCorrente
End Sub

Public Sub CarregaRegistroPorIndice(ByVal indice As Long)
'carrega os dados do registro baseado no índice
    indiceRegistro = indice

    Call CarregaRegistro
End Sub

Private Sub AtualizarArquivo(ByVal ReadOnly As Boolean)
    Dim caminhoCompleto As String
    'fecha o arquivo de dados e tenta abrí-lo
    'guarda o caminho
    caminhoCompleto = wbCadastro.FullName
    wbCadastro.Saved = True
    wbCadastro.Close SaveChanges:=False
    
    'abre o arquivo em modo escrita
    Set wbCadastro = Workbooks.Open(Filename:=caminhoCompleto, ReadOnly:=ReadOnly)
    
    'oculta a janela
    wbCadastro.Windows(1).Visible = False
    
    'reatribui a planilha de cadastro
    Set wsCadastro = wbCadastro.Worksheets(nomePlanilhaCadastro)
End Sub

Private Sub SalvaRegistro(ByVal id As Long, ByVal indice As Long)
    'tenta abrir o arquivo em modo escrita
    Call AtualizarArquivo(False)
    
    With wsCadastro
        .Cells(indice, colCodigoDoFornecedor).Value = id
        .Cells(indice, colTitulo).Value = Me.txtTitulo.Text
        .Cells(indice, colAtor).Value = Me.txtAtor1.Text
        .Cells(indice, colAtor2).Value = Me.txtAtores.Text
        .Cells(indice, colDiretor1).Value = Me.txtDiretor1.Text
        .Cells(indice, colTipo).Value = Me.txtTipo.Text
        .Cells(indice, colGenero).Value = Me.txtGenero.Text
        .Cells(indice, colAno).Value = Me.txtAno.Text
        .Cells(indice, colArquivo).Value = Me.txtArquivo.Text
        .Cells(indice, colTelefone).Value = Me.txtTelefone.Text
        .Cells(indice, colFax1).Value = Me.txtFax1.Text
        .Cells(indice, colFax).Value = Me.txtFax.Text
        .Cells(indice, colHomePage).Value = Me.txtHomePage.Text
    End With
    
    'salva o arquivo
    Call wbCadastro.Save
    
    'abre o arquivo novamente em modo leitura
    Call AtualizarArquivo(True)

    Call AtualizaRegistroCorrente
End Sub

Private Function PegaProximoId() As Long
    Dim rangeIds As Range
    'pega o range que se refere a toda a coluna do código (id)
    Set rangeIds = wsCadastro.Range(wsCadastro.Cells(indiceMinimo, colCodigoDoFornecedor), wsCadastro.Cells(wsCadastro.UsedRange.Rows.Count, colCodigoDoFornecedor))
    PegaProximoId = WorksheetFunction.Max(rangeIds) + 1
End Function

Private Sub AtualizaRegistroCorrente()
    lblNavigator.Caption = indiceRegistro - 1 & " de " & wsCadastro.UsedRange.Rows.Count - 1
    lblMensagem.Caption = ""
End Sub

Private Sub LimpaControles()
    Me.txtCodigoFornecedor.Text = ""
    Me.txtTitulo.Text = ""
    Me.txtAtor1.Text = ""
    Me.txtAtores.Text = ""
    Me.txtDiretor1.Text = ""
    Me.txtTipo.Text = ""
    Me.txtGenero.Text = ""
    Me.txtAno.Text = ""
    Me.txtArquivo.Text = ""
    Me.txtTelefone.Text = ""
    Me.txtFax1.Text = ""
    Me.txtFax.Text = ""
    Me.txtHomePage.Text = ""
End Sub

Private Sub HabilitaControles()
'Me.txtCodigoFornecedor.Locked = False
    Me.txtTitulo.Locked = False
    Me.txtAtor1.Locked = False
    Me.txtAtores.Locked = False
    Me.txtDiretor1.Locked = False
    Me.txtTipo.Locked = False
    Me.txtGenero.Locked = False
    Me.txtAno.Locked = False
    Me.txtArquivo.Locked = False
    Me.txtTelefone.Locked = False
    Me.txtFax1.Locked = False
    Me.txtFax.Locked = False
    Me.txtHomePage.Locked = False
    Me.txtTitulo.BackColor = corEnabledTextBox
    Me.txtAtor1.BackColor = corEnabledTextBox
    Me.txtAtores.BackColor = corEnabledTextBox
    Me.txtDiretor1.BackColor = corEnabledTextBox
    Me.txtTipo.BackColor = corEnabledTextBox
    Me.txtGenero.BackColor = corEnabledTextBox
    Me.txtAno.BackColor = corEnabledTextBox
    Me.txtArquivo.BackColor = corEnabledTextBox
    Me.txtTelefone.BackColor = corEnabledTextBox
    Me.txtFax1.BackColor = corEnabledTextBox
    Me.txtFax.BackColor = corEnabledTextBox
    Me.txtHomePage.BackColor = corEnabledTextBox
End Sub

Private Sub DesabilitaControles()
'Me.txtCodigoFornecedor.Locked = True
    Me.txtTitulo.Locked = True
    Me.txtAtor1.Locked = True
    Me.txtAtores.Locked = True
    Me.txtDiretor1.Locked = True
    Me.txtTipo.Locked = True
    Me.txtGenero.Locked = True
    Me.txtAno.Locked = True
    Me.txtArquivo.Locked = True
    Me.txtTelefone.Locked = True
    Me.txtFax1.Locked = True
    Me.txtFax.Locked = True
    Me.txtHomePage.Locked = True

    Me.txtTitulo.BackColor = corDisabledTextBox
    Me.txtAtor1.BackColor = corDisabledTextBox
    Me.txtAtores.BackColor = corDisabledTextBox
    Me.txtDiretor1.BackColor = corDisabledTextBox
    Me.txtTipo.BackColor = corDisabledTextBox
    Me.txtGenero.BackColor = corDisabledTextBox
    Me.txtAno.BackColor = corDisabledTextBox
    Me.txtArquivo.BackColor = corDisabledTextBox
    Me.txtTelefone.BackColor = corDisabledTextBox
    Me.txtFax1.BackColor = corDisabledTextBox
    Me.txtFax.BackColor = corDisabledTextBox
    Me.txtHomePage.BackColor = corDisabledTextBox
End Sub

Private Sub HabilitaBotoesAlteracao()
'habilita os botões de alteração
    optAlterar.Enabled = True
    optExcluir.Enabled = True
    optNovo.Enabled = True
    btnPesquisar.Enabled = True
    btnOK.Enabled = False
    btnCancelar.Enabled = False

    'limpa os valores dos controles
    optAlterar.Value = False
    optExcluir.Value = False
    optNovo.Value = False
End Sub

Private Sub DesabilitaBotoesAlteracao()
'desabilita os botões de alteração
    optAlterar.Enabled = False
    optExcluir.Enabled = False
    optNovo.Enabled = False
    btnPesquisar.Enabled = False
    btnOK.Enabled = True
    btnCancelar.Enabled = True
End Sub

Public Function ProcuraIndiceRegistroPodId(ByVal id As Long) As Long
    Dim i As Long
    Dim retorno As Long
    Dim encontrado As Boolean

    i = indiceMinimo
    With wsCadastro
        Do While Not IsEmpty(.Cells(i, colCodigoDoFornecedor))
            If .Cells(i, colCodigoDoFornecedor).Value = id Then
                retorno = i
                encontrado = True
                Exit Do
            End If
            i = i + 1
        Loop
    End With

    'caso não encontre o registro, retorna -1
    If Not encontrado Then
        retorno = -1
    End If

    ProcuraIndiceRegistroPodId = i
End Function

Private Sub DefinePlanilhaDados()
    Dim abrirArquivo As Boolean
    Dim wb As Workbook
    Dim caminhoCompleto As String
    Dim ARQUIVO_DADOS As String
    Dim PASTA_DADOS As String
    
    abrirArquivo = True
    
    ARQUIVO_DADOS = Range("ARQUIVO_DADOS").Value
    PASTA_DADOS = Range("PASTA_DADOS").Value
    
    If ThisWorkbook.Name <> ARQUIVO_DADOS Then
        'monta a string do caminho completo
        If PASTA_DADOS = vbNullString Or PASTA_DADOS = "" Then
            caminhoCompleto = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, vbNullString) & ARQUIVO_DADOS
        Else
            If Right(PASTA_DADOS, 1) = "\" Then
                caminhoCompleto = PASTA_DADOS & ARQUIVO_DADOS
            Else
                caminhoCompleto = PASTA_DADOS & "\" & ARQUIVO_DADOS
            End If
        End If
        
        'verifica se o arquivo não está aberto
        For Each wb In Application.Workbooks
            If wb.Name = ARQUIVO_DADOS Then
                abrirArquivo = False
                Exit For
            End If
        Next
        
        'atribui o arquivo
        If abrirArquivo Then
            Set wbCadastro = Workbooks.Open(Filename:=caminhoCompleto, ReadOnly:=True)
        Else
            Set wbCadastro = Workbooks(ARQUIVO_DADOS)
        End If
    Else
        Set wbCadastro = ThisWorkbook
    End If
    
    Set wsCadastro = wbCadastro.Worksheets(nomePlanilhaCadastro)
    
    'oculta o arquivo de dados
    wbCadastro.Windows(1).Visible = False
    
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    'fecha a planilha de dados, se estiver aberta
    If Not wbCadastro Is Nothing Then
        wbCadastro.Saved = True
        wbCadastro.Close SaveChanges:=False
    End If
    
    Set wbCadastro = Nothing
End Sub

Persiste o erro no formulario de pesquisa

Aparece o Erro:
"Erro em tempo de Execução '424"; O objeto é obrigatorio".
A linha é:

Código: Selecionar todos

Private Sub btnPesquisar_Click()
frmPesquisa.Show (aparece em amarelo)
End Sub
Não sei como resolver

Re: Erro em tempo de execução

Enviado: Seg Jan 20, 2020 9:32 pm
por webmaster
Colega,

Recomendo começar a dar uma estudada em depuração de código. Dá uma olhada neste vídeo:

https://www.youtube.com/watch?v=TuJ-F5P_n5g

Re: Erro em tempo de execução

Enviado: Qua Jan 22, 2020 11:17 am
por tarefa
Desisti. Muito complicado. Valeu por tentar ajudar.

Re: Erro em tempo de execução

Enviado: Qua Jan 22, 2020 11:18 am
por tarefa
Desisti. Muito complicado. Valeu por tentar ajudar.

Re: Erro em tempo de execução [MAIS OU MENOS RESVOLIDO]

Enviado: Qua Jan 22, 2020 5:33 pm
por webmaster
Ok!