ATENÇÃO NOVOS USUÁRIOS

Se registrou recentemente? Seu cadastro será avaliado e mendiante aprovação, a conta será ativada e você poderá usufruir do fórum. O tempo de avaliação gira em torno de 24 a 48 horas.

Esqueceu sua senha?

Você pode usar o mecanismo de lembrete neste link: Recuperar senha

Você receberá um link de reativação no email cadastrado.

Não recebeu o email? Lembre-se checar o Lixo Eletrônico.

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

Fórum para agrupar todas as propostas de modelos de planilhas de Excel que essa comunidade consegue imaginar. Teve uma idéia? Produziu algo bem bacana? Esse é o lugar!

Moderador: Rafael Monteiro

tarefa
Acabou de chegar
Acabou de chegar
Mensagens: 4
Registrado em: Seg Jan 13, 2020 8:36 am

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

Mensagem por tarefa » Sáb Jan 18, 2020 10:13 am

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.



Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
webmaster
Administrador
Mensagens: 2796
Registrado em: Sex Jul 24, 2009 2:44 pm
Contato:

Re: Erro em tempo de execução

Mensagem por webmaster » Sáb Jan 18, 2020 6:50 pm

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.


Tomás
https://www.tomasvasquez.com.br/blog
https://www.tomasvasquez.com.br/cursocsharp
https://twitter.com/tomamais
Se sua dúvida foi solucionada, acrescente [RESOLVIDO] ao título.

tarefa
Acabou de chegar
Acabou de chegar
Mensagens: 4
Registrado em: Seg Jan 13, 2020 8:36 am

Re: Erro em tempo de execução

Mensagem por tarefa » Seg Jan 20, 2020 4:34 pm

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



Avatar do usuário
webmaster
Administrador
Mensagens: 2796
Registrado em: Sex Jul 24, 2009 2:44 pm
Contato:

Re: Erro em tempo de execução

Mensagem por webmaster » Seg Jan 20, 2020 9:32 pm

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


Tomás
https://www.tomasvasquez.com.br/blog
https://www.tomasvasquez.com.br/cursocsharp
https://twitter.com/tomamais
Se sua dúvida foi solucionada, acrescente [RESOLVIDO] ao título.

Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


tarefa
Acabou de chegar
Acabou de chegar
Mensagens: 4
Registrado em: Seg Jan 13, 2020 8:36 am

Re: Erro em tempo de execução

Mensagem por tarefa » Qua Jan 22, 2020 11:17 am

Desisti. Muito complicado. Valeu por tentar ajudar.



tarefa
Acabou de chegar
Acabou de chegar
Mensagens: 4
Registrado em: Seg Jan 13, 2020 8:36 am

Re: Erro em tempo de execução

Mensagem por tarefa » Qua Jan 22, 2020 11:18 am

Desisti. Muito complicado. Valeu por tentar ajudar.




Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder