Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
**R E S O L V I D O ** Erro em Tempo de Execução '91'
**R E S O L V I D O ** Erro em Tempo de Execução '91'
Pessoal estou tentando criar um banco de dados de Clientes porem estou com o erro apresentado no titulo e nao consigo resolver
segue o código usado
O Erro esta na linha 88 (Destaquei ela)
___________________________________________________________________________________________________________________________________________
Public LinhaAtual As Long
Sub lsShowStudents()
frmCadastroStudents.Show
End Sub
Sub lsInserirStudent()
Dim iTotalLinhas As Integer
Dim lUltima As Long
iTotalLinhas = Sheets("Instrumentos").Cells(Rows.Count, 1).End(xlUp).Row + 1
If IsNumeric(Sheets("Instrumentos").Cells(iTotalLinhas - 1, 1).Value) Then
lUltima = Sheets("Instrumentos").Cells(iTotalLinhas - 1, 1).Value + 1
Else
lUltima = 1
End If
With frmCadastroStudents
.lblCod = lUltima
Sheets("Clientes").Cells(iTotalLinhas, 1).Value = lUltima
Sheets("Clientes").Cells(iTotalLinhas, 2).Value = .txtName
Sheets("Clientes").Cells(iTotalLinhas, 3).Value = .txtAddress
Sheets("Clientes").Cells(iTotalLinhas, 4).Value = .txtNumber
Sheets("Clientes").Cells(iTotalLinhas, 5).Value = .txtNeighb
Sheets("Clientes").Cells(iTotalLinhas, 6).Value = .txtCity
Sheets("Clientes").Cells(iTotalLinhas, 7).Value = .txtUF
Sheets("Clientes").Cells(iTotalLinhas, 8).Value = .txtDDD1
Sheets("Clientes").Cells(iTotalLinhas, 9).Value = .txtPhone1
Sheets("Clientes").Cells(iTotalLinhas, 10).Value = .txtDDD2
Sheets("Clientes").Cells(iTotalLinhas, 11).Value = .txtPhone2
Sheets("Clientes").Cells(iTotalLinhas, 12).Value = .txtEmail
End With
End Sub
Sub lsLocalizaRegistroStudent(ByVal lRegistro As Long)
Dim lLinha As Long
'Sheets("Instrumentos").Activate
iTotalLinhas = Sheets("Instrumentos").Cells(Rows.Count, 1).End(xlUp).Row
'Define a Range de Pesquisa
Set currentFind = Worksheets("Instrumentos").Range("A:A").Find(lRegistro, , _
Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, _
Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False)
If lRegistro = 999999 Then
lLinha = iTotalLinhas
Set currentFind = Worksheets("Instrumentos").Range("A:A").Find(lLinha - 1, , _
Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, _
Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False)
Else
If Not currentFind Is Nothing Then
lLinha = currentFind.Row
End If
End If
If Not currentFind Is Nothing Then
With frmCadastroStudents
.lblCod = Sheets("Instrumentos").Cells(lLinha, 1).Value
.txtName = Sheets("Instrumentos").Cells(lLinha, 2).Value
.txtAddress = Sheets("Instrumentos").Cells(lLinha, 3).Value
.txtNumber = Sheets("Instrumentos").Cells(lLinha, 4).Value
.txtNeighb = Sheets("Instrumentos").Cells(lLinha, 5).Value
.txtCity = Sheets("Instrumentos").Cells(lLinha, 6).Value
.txtUF = Sheets("Instrumentos").Cells(lLinha, 7).Value
.txtDDD1 = Sheets("Instrumentos").Cells(lLinha, 8).Value
.txtPhone1 = Sheets("Instrumentos").Cells(lLinha, 9).Value
.txtDDD2 = Sheets("Instrumentos").Cells(lLinha, 10).Value
.txtPhone2 = Sheets("Instrumentos").Cells(lLinha, 11).Value
.txtEmail = Sheets("Instrumentos").Cells(lLinha, 12).Value
frmCadastroStudents.Image1.Picture = LoadPicture(Worksheets("Instrumentos").Cells.Range("M" & lLinha).Value)
frmCadastroStudents.Image1.PictureSizeMode = fmPictureSizeModeStretch
End With
End If
End Sub
Sub lsAlterarStudent()
'Define a Range de Pesquisa
Set currentFind = Worksheets("Instrumentos").Range("A:A").Find(frmCadastroStudents.lblCod, 1, _
Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, _
Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False)
lLinha = currentFind.Row
With frmCadastroStudents
Sheets("Clientes").Cells(lLinha, 2).Value = .txtName
Sheets("Clientes").Cells(lLinha, 3).Value = .txtAddress
Sheets("Clientes").Cells(lLinha, 4).Value = .txtNumber
Sheets("Clientes").Cells(lLinha, 5).Value = .txtNeighb
Sheets("Clientes").Cells(lLinha, 6).Value = .txtCity
Sheets("Clientes").Cells(lLinha, 7).Value = .txtUF
Sheets("Clientes").Cells(lLinha, 8).Value = .txtDDD1
Sheets("Clientes").Cells(lLinha, 9).Value = .txtPhone1
Sheets("Clientes").Cells(lLinha, 10).Value = .txtDDD2
Sheets("Clientes").Cells(lLinha, 11).Value = .txtPhone2
Sheets("Clientes").Cells(lLinha, 12).Value = .txtEmail
LinhaAtual = lLinha
End With
End Sub
Sub lsHabilitar()
With frmCadastroStudents
.txtName.Enabled = True
.txtAddress.Enabled = True
.txtNumber.Enabled = True
.txtNeighb.Enabled = True
.txtCity.Enabled = True
.txtUF.Enabled = True
.txtDDD1.Enabled = True
.txtPhone1.Enabled = True
.txtDDD2.Enabled = True
.txtPhone2.Enabled = True
.txtEmail.Enabled = True
.Image1.Enabled = True
End With
End Sub
Sub lsDesabilitar()
With frmCadastroStudents
.txtName.Enabled = False
.txtAddress.Enabled = False
.txtNumber.Enabled = False
.txtNeighb.Enabled = False
.txtCity.Enabled = False
.txtUF.Enabled = False
.txtDDD1.Enabled = False
.txtPhone1.Enabled = False
.txtDDD2.Enabled = False
.txtPhone2.Enabled = False
.txtEmail.Enabled = False
.Image1.Enabled = False
End With
End Sub
Sub lsLimparStudents()
With frmCadastroStudents
.lblCod.Caption = ""
.txtName.Text = ""
.txtAddress.Text = ""
.txtNumber.Text = ""
.txtNeighb.Text = ""
.txtCity.Text = ""
.txtUF.Text = ""
.txtDDD1.Text = ""
.txtPhone1.Text = ""
.txtDDD2.Text = ""
.txtPhone2.Text = ""
.txtEmail.Text = ""
.Image1.Picture = LoadPicture("")
End With
End Sub
Function lfValidarDados() As Boolean
lfValidarDados = False
With Worksheets("Validacao")
If frmCadastroStudents.txtName.Text = "" And .Cells(3, 2).Value = "Sim" Then
MsgBox "O campo Nome é obrigatório!"
frmCadastroStudents.txtName.SetFocus
GoTo Sair
End If
If frmCadastroStudents.txtAddress.Text = "" And .Cells(4, 2).Value = "Sim" Then
MsgBox "O campo Logradouro é obrigatório!"
frmCadastroStudents.txtAddress.SetFocus
GoTo Sair
End If
If frmCadastroStudents.txtNumber.Text = "" And .Cells(5, 2).Value = "Sim" Then
MsgBox "O campo Número é obrigatório!"
frmCadastroStudents.txtNumber.SetFocus
GoTo Sair
End If
If frmCadastroStudents.txtNeighb.Text = "" And .Cells(6, 2).Value = "Sim" Then
MsgBox "O campo Bairro é obrigatório!"
frmCadastroStudents.txtNeighb.SetFocus
GoTo Sair
End If
If frmCadastroStudents.txtCity.Text = "" And .Cells(7, 2).Value = "Sim" Then
MsgBox "O campo Cidade é obrigatório!"
frmCadastroStudents.txtCity.SetFocus
GoTo Sair
End If
If frmCadastroStudents.txtUF.Text = "" And .Cells(8, 2).Value = "Sim" Then
MsgBox "O campo UF é obrigatório!"
frmCadastroStudents.txtUF.SetFocus
GoTo Sair
End If
If frmCadastroStudents.txtDDD1.Text = "" And .Cells(9, 2).Value = "Sim" Then
MsgBox "O campo DDD1 é obrigatório!"
frmCadastroStudents.txtDDD1.SetFocus
GoTo Sair
End If
If frmCadastroStudents.txtPhone1.Text = "" And .Cells(10, 2).Value = "Sim" Then
MsgBox "O campo Fone1 é obrigatório!"
frmCadastroStudents.txtPhone1.SetFocus
GoTo Sair
End If
If frmCadastroStudents.txtDDD2.Text = "" And .Cells(11, 2).Value = "Sim" Then
MsgBox "O campo DDD2 é obrigatório!"
frmCadastroStudents.txtDDD2.SetFocus
GoTo Sair
End If
If frmCadastroStudents.txtPhone2.Text = "" And .Cells(12, 2).Value = "Sim" Then
MsgBox "O campo Fone2 é obrigatório!"
frmCadastroStudents.txtPhone2.SetFocus
GoTo Sair
End If
If frmCadastroStudents.txtEmail.Text = "" And .Cells(13, 2).Value = "Sim" Then
MsgBox "O campo e-mail é obrigatório!"
frmCadastroStudents.txtEmail.SetFocus
GoTo Sair
End If
End With
lfValidarDados = True
Sair:
Exit Function
End Function
segue o código usado
O Erro esta na linha 88 (Destaquei ela)
___________________________________________________________________________________________________________________________________________
Public LinhaAtual As Long
Sub lsShowStudents()
frmCadastroStudents.Show
End Sub
Sub lsInserirStudent()
Dim iTotalLinhas As Integer
Dim lUltima As Long
iTotalLinhas = Sheets("Instrumentos").Cells(Rows.Count, 1).End(xlUp).Row + 1
If IsNumeric(Sheets("Instrumentos").Cells(iTotalLinhas - 1, 1).Value) Then
lUltima = Sheets("Instrumentos").Cells(iTotalLinhas - 1, 1).Value + 1
Else
lUltima = 1
End If
With frmCadastroStudents
.lblCod = lUltima
Sheets("Clientes").Cells(iTotalLinhas, 1).Value = lUltima
Sheets("Clientes").Cells(iTotalLinhas, 2).Value = .txtName
Sheets("Clientes").Cells(iTotalLinhas, 3).Value = .txtAddress
Sheets("Clientes").Cells(iTotalLinhas, 4).Value = .txtNumber
Sheets("Clientes").Cells(iTotalLinhas, 5).Value = .txtNeighb
Sheets("Clientes").Cells(iTotalLinhas, 6).Value = .txtCity
Sheets("Clientes").Cells(iTotalLinhas, 7).Value = .txtUF
Sheets("Clientes").Cells(iTotalLinhas, 8).Value = .txtDDD1
Sheets("Clientes").Cells(iTotalLinhas, 9).Value = .txtPhone1
Sheets("Clientes").Cells(iTotalLinhas, 10).Value = .txtDDD2
Sheets("Clientes").Cells(iTotalLinhas, 11).Value = .txtPhone2
Sheets("Clientes").Cells(iTotalLinhas, 12).Value = .txtEmail
End With
End Sub
Sub lsLocalizaRegistroStudent(ByVal lRegistro As Long)
Dim lLinha As Long
'Sheets("Instrumentos").Activate
iTotalLinhas = Sheets("Instrumentos").Cells(Rows.Count, 1).End(xlUp).Row
'Define a Range de Pesquisa
Set currentFind = Worksheets("Instrumentos").Range("A:A").Find(lRegistro, , _
Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, _
Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False)
If lRegistro = 999999 Then
lLinha = iTotalLinhas
Set currentFind = Worksheets("Instrumentos").Range("A:A").Find(lLinha - 1, , _
Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, _
Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False)
Else
If Not currentFind Is Nothing Then
lLinha = currentFind.Row
End If
End If
If Not currentFind Is Nothing Then
With frmCadastroStudents
.lblCod = Sheets("Instrumentos").Cells(lLinha, 1).Value
.txtName = Sheets("Instrumentos").Cells(lLinha, 2).Value
.txtAddress = Sheets("Instrumentos").Cells(lLinha, 3).Value
.txtNumber = Sheets("Instrumentos").Cells(lLinha, 4).Value
.txtNeighb = Sheets("Instrumentos").Cells(lLinha, 5).Value
.txtCity = Sheets("Instrumentos").Cells(lLinha, 6).Value
.txtUF = Sheets("Instrumentos").Cells(lLinha, 7).Value
.txtDDD1 = Sheets("Instrumentos").Cells(lLinha, 8).Value
.txtPhone1 = Sheets("Instrumentos").Cells(lLinha, 9).Value
.txtDDD2 = Sheets("Instrumentos").Cells(lLinha, 10).Value
.txtPhone2 = Sheets("Instrumentos").Cells(lLinha, 11).Value
.txtEmail = Sheets("Instrumentos").Cells(lLinha, 12).Value
frmCadastroStudents.Image1.Picture = LoadPicture(Worksheets("Instrumentos").Cells.Range("M" & lLinha).Value)
frmCadastroStudents.Image1.PictureSizeMode = fmPictureSizeModeStretch
End With
End If
End Sub
Sub lsAlterarStudent()
'Define a Range de Pesquisa
Set currentFind = Worksheets("Instrumentos").Range("A:A").Find(frmCadastroStudents.lblCod, 1, _
Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, _
Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False)
lLinha = currentFind.Row
With frmCadastroStudents
Sheets("Clientes").Cells(lLinha, 2).Value = .txtName
Sheets("Clientes").Cells(lLinha, 3).Value = .txtAddress
Sheets("Clientes").Cells(lLinha, 4).Value = .txtNumber
Sheets("Clientes").Cells(lLinha, 5).Value = .txtNeighb
Sheets("Clientes").Cells(lLinha, 6).Value = .txtCity
Sheets("Clientes").Cells(lLinha, 7).Value = .txtUF
Sheets("Clientes").Cells(lLinha, 8).Value = .txtDDD1
Sheets("Clientes").Cells(lLinha, 9).Value = .txtPhone1
Sheets("Clientes").Cells(lLinha, 10).Value = .txtDDD2
Sheets("Clientes").Cells(lLinha, 11).Value = .txtPhone2
Sheets("Clientes").Cells(lLinha, 12).Value = .txtEmail
LinhaAtual = lLinha
End With
End Sub
Sub lsHabilitar()
With frmCadastroStudents
.txtName.Enabled = True
.txtAddress.Enabled = True
.txtNumber.Enabled = True
.txtNeighb.Enabled = True
.txtCity.Enabled = True
.txtUF.Enabled = True
.txtDDD1.Enabled = True
.txtPhone1.Enabled = True
.txtDDD2.Enabled = True
.txtPhone2.Enabled = True
.txtEmail.Enabled = True
.Image1.Enabled = True
End With
End Sub
Sub lsDesabilitar()
With frmCadastroStudents
.txtName.Enabled = False
.txtAddress.Enabled = False
.txtNumber.Enabled = False
.txtNeighb.Enabled = False
.txtCity.Enabled = False
.txtUF.Enabled = False
.txtDDD1.Enabled = False
.txtPhone1.Enabled = False
.txtDDD2.Enabled = False
.txtPhone2.Enabled = False
.txtEmail.Enabled = False
.Image1.Enabled = False
End With
End Sub
Sub lsLimparStudents()
With frmCadastroStudents
.lblCod.Caption = ""
.txtName.Text = ""
.txtAddress.Text = ""
.txtNumber.Text = ""
.txtNeighb.Text = ""
.txtCity.Text = ""
.txtUF.Text = ""
.txtDDD1.Text = ""
.txtPhone1.Text = ""
.txtDDD2.Text = ""
.txtPhone2.Text = ""
.txtEmail.Text = ""
.Image1.Picture = LoadPicture("")
End With
End Sub
Function lfValidarDados() As Boolean
lfValidarDados = False
With Worksheets("Validacao")
If frmCadastroStudents.txtName.Text = "" And .Cells(3, 2).Value = "Sim" Then
MsgBox "O campo Nome é obrigatório!"
frmCadastroStudents.txtName.SetFocus
GoTo Sair
End If
If frmCadastroStudents.txtAddress.Text = "" And .Cells(4, 2).Value = "Sim" Then
MsgBox "O campo Logradouro é obrigatório!"
frmCadastroStudents.txtAddress.SetFocus
GoTo Sair
End If
If frmCadastroStudents.txtNumber.Text = "" And .Cells(5, 2).Value = "Sim" Then
MsgBox "O campo Número é obrigatório!"
frmCadastroStudents.txtNumber.SetFocus
GoTo Sair
End If
If frmCadastroStudents.txtNeighb.Text = "" And .Cells(6, 2).Value = "Sim" Then
MsgBox "O campo Bairro é obrigatório!"
frmCadastroStudents.txtNeighb.SetFocus
GoTo Sair
End If
If frmCadastroStudents.txtCity.Text = "" And .Cells(7, 2).Value = "Sim" Then
MsgBox "O campo Cidade é obrigatório!"
frmCadastroStudents.txtCity.SetFocus
GoTo Sair
End If
If frmCadastroStudents.txtUF.Text = "" And .Cells(8, 2).Value = "Sim" Then
MsgBox "O campo UF é obrigatório!"
frmCadastroStudents.txtUF.SetFocus
GoTo Sair
End If
If frmCadastroStudents.txtDDD1.Text = "" And .Cells(9, 2).Value = "Sim" Then
MsgBox "O campo DDD1 é obrigatório!"
frmCadastroStudents.txtDDD1.SetFocus
GoTo Sair
End If
If frmCadastroStudents.txtPhone1.Text = "" And .Cells(10, 2).Value = "Sim" Then
MsgBox "O campo Fone1 é obrigatório!"
frmCadastroStudents.txtPhone1.SetFocus
GoTo Sair
End If
If frmCadastroStudents.txtDDD2.Text = "" And .Cells(11, 2).Value = "Sim" Then
MsgBox "O campo DDD2 é obrigatório!"
frmCadastroStudents.txtDDD2.SetFocus
GoTo Sair
End If
If frmCadastroStudents.txtPhone2.Text = "" And .Cells(12, 2).Value = "Sim" Then
MsgBox "O campo Fone2 é obrigatório!"
frmCadastroStudents.txtPhone2.SetFocus
GoTo Sair
End If
If frmCadastroStudents.txtEmail.Text = "" And .Cells(13, 2).Value = "Sim" Then
MsgBox "O campo e-mail é obrigatório!"
frmCadastroStudents.txtEmail.SetFocus
GoTo Sair
End If
End With
lfValidarDados = True
Sair:
Exit Function
End Function
Editado pela última vez por Andersog em Qua Dez 17, 2014 1:31 pm, em um total de 1 vez.
-
- Colaborador
- Mensagens: 98
- Registrado em: Qui Nov 01, 2012 2:37 pm
Re: Erro em Tempo de Execução '91'
Andersog, bom dia!
Para facilitar, poderia disponibilizar o seu arquivo para ficar mais fácil solucionar o erro?
Poderá compactar e adicionar aqui no fórum!!!
Att,
Para facilitar, poderia disponibilizar o seu arquivo para ficar mais fácil solucionar o erro?
Poderá compactar e adicionar aqui no fórum!!!
Att,
Re: Erro em Tempo de Execução '91'
Marcos ta ai o ArquivoMarciel Silva escreveu:Andersog, bom dia!
Para facilitar, poderia disponibilizar o seu arquivo para ficar mais fácil solucionar o erro?
Poderá compactar e adicionar aqui no fórum!!!
Att,
http://1drv.ms/1szQEfZ
-
- Colaborador
- Mensagens: 98
- Registrado em: Qui Nov 01, 2012 2:37 pm
Re: Erro em Tempo de Execução '91'
Andersog, boa tarde!
Fiz todos os testes aqui e não deu nenhum erro.
Meu Office é 2007.
Qual é a sua versão?
Se a resposta foi útil, clique na mãozinha!!!
Att,
Fiz todos os testes aqui e não deu nenhum erro.
Meu Office é 2007.
Qual é a sua versão?
Se a resposta foi útil, clique na mãozinha!!!
Att,
Re: Erro em Tempo de Execução '91'
Marciel meu office é 2010, consegui resolver o problema era a imagem que estava salva em um endereço diferente, agradeço a disponibilidade.