Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
Re: Erro em tempo de execução [MAIS OU MENOS RESVOLIDO]
Moderador: Rafael Monteiro
Re: Erro em tempo de execução [MAIS OU MENOS RESVOLIDO]
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.
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
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
Desculpe ainda me falta o conhecimento necessário. Pode me ajudar??
Persiste o erro no formulario de pesquisa
Aparece o Erro:
"Erro em tempo de Execução '424"; O objeto é obrigatorio".
A linha é:
Não sei como resolver
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
Re: Erro em tempo de execução
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
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