ERRO TEMPO DE EXECUÇÃO '91'

carloseg · Mensagem por **carloseg** » Ter Jul 18, 2017 10:41 pm

Pessoal boa noite, estou me deparando com o seguinte problema ERRO TEMPO DE EXECUÇÃO '91'.
Percebi que o erro ocorre porque o Listview está vazio, quando clico nelo aparece essa mensagem.

segue as fotos do projeto e o código.

Imagem

Código: Selecionar todos

' INICIO CONTROLE BOTÕES

Private Sub btn_cancelarhorario_Click()
'limpa as caixas de texto deixando-as vazias

    txt_idhorario.Value = ""
    txt_horario.Value = ""
    
' Desabilitar campos para inserção de dados

    txt_idhorario.Locked = True
    txt_horario.Locked = True
    
    btn_salvarhorario.Locked = True
    btn_editargravarhorario.Locked = True
    btn_editarhorario.Locked = False
    btn_excluirhorario.Locked = True
    
End Sub

Private Sub btn_editarhorario_Click()
  
   If txt_horario = "" Then
 MsgBox " Nenhum campo selecionado para editar! Selecione abaixo!", vbInformation, "CADASTRO HORARIO"
   Else
   
   txt_horario.Locked = False
   btn_novohorario.Locked = False
   btn_salvarhorario.Visible = False
   btn_cancelarhorario.Locked = False
   btn_excluirhorario.Locked = True
   btn_editargravarhorario.Visible = True
   btn_editargravarhorario.Locked = False
   btn_excluirhorario.Locked = False
   txt_horario.SetFocus
   
   End If
   
End Sub

Private Sub btn_editargravarhorario_Click()
    Dim codigo As Double
    'Ativar a planilha cadastro clientes
    ThisWorkbook.Worksheets("HORÁRIO").Activate
    
    Linha = 2
    codigo = txt_idhorario.Text
    Sheets("HORÁRIO").Select
    Do Until Sheets("HORÁRIO").Cells(Linha, 1) = ""
    ' condição para localizar código
    If Sheets("HORÁRIO").Cells(Linha, 1) = codigo Then
    Sheets("HORÁRIO").Cells(Linha, 1).Select

'Carregar os dados digitados nas caixas de texto para a planilha

    ActiveCell.Offset(0, 0).Value = txt_idhorario.Value
    ActiveCell.Offset(0, 1).Value = Format(txt_horario.Value, "hh:mm")
   
    txt_horario.SetFocus ' foco sobre o campo




End If
    Linha = Linha + 1
Loop
   
'MENSAGEM CLIENTE CADASTRADO COM SUCESSO
     
    MsgBox "HORÁRIO alterado com sucesso!", vbInformation, "Alteração do horário"

' limpa e carrega novos registros na listview

    ListView_horario.ListItems.Clear
    lin = 2
    Range("A2").Select
    While ActiveCell <> ""
    Set Linha = ListView_horario.ListItems.Add(Text:=Sheets("HORÁRIO").Cells(lin, 1).Value) 'Código
    Linha.ListSubItems.Add Text:=Format(Sheets("HORÁRIO").Cells(lin, 2).Value, "hh:mm")
    
    
    
    lin = lin + 1
    ActiveCell.Offset(1, 0).Activate

      
' Desabilitar campos

    txt_idhorario.Locked = True
    txt_horario.Locked = True
    btn_editargravarhorario.Locked = True
    txt_idhorario.Locked = False
    txt_horario.Locked = False
    btn_salvarhorario.Locked = False
    btn_cancelarhorario.Locked = False
    btn_editarhorario.Locked = False
    btn_excluirhorario.Locked = True

   Wend

End Sub

Private Sub btn_excluirhorario_Click()

Dim codigo As Double
    Linha = 2
    codigo = txt_idhorario.Text
    Sheets("HORÁRIO").Select
    Do Until Sheets("HORÁRIO").Cells(Linha, 1) = ""
    ' condição para localizar código
    If Sheets("HORÁRIO").Cells(Linha, 1) = codigo Then
    Sheets("HORÁRIO").Cells(Linha, 1).Select


    If ActiveCell = codigo Then
    resposta = MsgBox("Deseja Excluir esse Registro?", vbYesNo, "ATENÇÃO.....")
    If resposta = vbYes Then
    ActiveCell.EntireRow.Delete

    ' remove o item na listview
    frm_horario.ListView_horario.ListItems.Remove (frm_horario.ListView_horario.SelectedItem.Index)
    MsgBox ("Registro Excluido da Base de Dados com Sucesso!"), vbInformation, "Registro Excluido"


'Limpar as caixas de texto
    txt_idhorario.Value = ""
    txt_horario.Value = ""

    btn_editarhorario.Locked = False
    btn_cancelarhorario.Locked = True
    btn_excluirhorario.Locked = True

Else

End If
End If
End If

    Linha = Linha + 1
Loop
    label_registros = Me.ListView_horario.ListItems.Count
End Sub

' BOTÃO NOVO
Private Sub btn_novohorario_Click()
    
    ThisWorkbook.Worksheets("HORÁRIO").Activate 'Ativar a planilha cadastro horario
    Range("A1").Select 'Selecionar a célula A1
    While ActiveCell <> ""
    If ActiveCell <> "ID HORÁRIO" Then
    txt_idhorario.Text = ActiveCell.Offset(0, 0).Value + 1
    Else
    txt_idhorario.Text = 1
    End If
    ActiveCell.Offset(1, 0).Activate
Wend
    
'Limpar as caixas de texto

    txt_horario.Value = ""
    
' Desabilitar campos

    txt_idhorario.Locked = True
    txt_horario.Locked = False
    btn_cancelarhorario.Locked = False
    btn_editarhorario.Locked = True
    btn_excluirhorario.Locked = True
    btn_salvarhorario.Visible = True
    btn_salvarhorario.Locked = False
    btn_editargravarhorario.Visible = False
    
    txt_horario.SetFocus
End Sub

Private Sub btn_salvarhorario_Click()
ThisWorkbook.Worksheets("HORÁRIO").Activate 'Ativar a planilha cadastro clientes
    Range("A1").Select 'Selecionar a célula A1
    
    'Procurar a primeira célula vazia
    Do
      If Not (IsEmpty(ActiveCell)) Then
          ActiveCell.Offset(1, 0).Select
      End If
    Loop Until IsEmpty(ActiveCell) = True
    
    ' Campo nome não pode ser vazio
    
    If txt_horario.Text = "" Then
    MsgBox "O Campo horario não pode ser vazio!", vbOKOnly, "Atenção!"

Else

'Pegar dados digitados nas caixas de texto da planilha

    ActiveCell.Offset(0, 0).Value = txt_idhorario.Value
    'ActiveCell.Offset(0, 1).Value = txt_horario.Value
    ActiveCell.Offset(0, 1).Value = txt_horario.Value
    
    
 
'MENSAGEM CLIENTE CADASTRADO COM SUCESSO
    
    MsgBox "HORÁRIO cadastrado com sucesso!", vbInformation, "Cadastro de Clientes"

' limpa e carrega novos registros na listview

    ListView_horario.ListItems.Clear
    lin = 2
    Range("A2").Select
    While ActiveCell <> ""
    Set Linha = ListView_horario.ListItems.Add(Text:=Sheets("HORÁRIO").Cells(lin, 1).Value) 'Código
    Linha.ListSubItems.Add Text:=Format(Sheets("HORÁRIO").Cells(lin, 2).Value, "hh:mm")
        
       
    lin = lin + 1
    ActiveCell.Offset(1, 0).Activate
    
    Wend
    
'Limpar as caixas de texto

    txt_idhorario.Value = ""
    txt_horario.Value = ""
    txt_horario.SetFocus ' foco cursor sobre o campo


' Desabilitar campos para inserção de dados

    txt_idhorario.Locked = True
    txt_horario.Locked = True
    btn_salvarhorario.Locked = True
    btn_cancelarhorario.Locked = True
    btn_editarhorario.Locked = False

End If
    label_registros = Me.ListView_horario.ListItems.Count
End Sub

Private Sub ListView_horario_Click()
Call carregartextbox
End Sub

' Busca
Private Sub txt_buscahorario_Change()

Dim Abas  As Worksheet
    Dim Linha As Integer
    Dim xPesq As String
    Dim xCel  As String
    Dim Regs  As Integer
    Dim xRegs As Integer
    Dim xPlan As String
    Dim Lv


    Planilha10.Activate
    xPlan = Planilha10.Name
    xRegs = Range("A" & Rows.Count).End(xlUp).Row
    xPesq = txt_buscahorario.Value = Format(txt_buscahorario.Value(tString), "HH:MM")
    Linha = 2
    'TextBox1.Value = Format(TimeValue(tString), "HH:MM")

    Set Abas = ThisWorkbook.Worksheets(xPlan)
    With Abas

        Me.ListView_horario.ListItems.Clear
        While .Cells(Linha, 1) <> Empty


            For coluna = 2 To 2 'faz a pesquisa entre as colunas 1 e 2
            xCel = .Cells(Linha, coluna)

            If InStr(1, UCase(xCel), UCase(xPesq), 1) Then

                Set Lv = ListView_horario.ListItems.Add(Text:=Planilha10.Cells(Linha, 1)) 'Código
                Lv.ListSubItems.Add Text:=Format(Planilha10.Cells(Linha, 2), "hh:mm") ' horario
                'Lv.ListSubItems.Add Text:=Planilha10.Cells(Linha, 2) ' horario


                     GoTo proxima_linha


            End If

            Next coluna

proxima_linha:

          Linha = Linha + 1

          Wend


    End With
    Set Lv = Nothing


    label_registros = Me.ListView_horario.ListItems.Count

End Sub

Private Sub UserForm_Initialize()
' Ativar Planilha

Sheets("HORÁRIO").Select


' Listview Clientes com ordenação - Colocar no Initialize

With ListView_horario
    .Gridlines = True
    .View = lvwReport
    .FullRowSelect = True
    .ColumnHeaders.Add(Text:="Código", Width:=0, Alignment:=0).Tag = "number"
    .ColumnHeaders.Add(Text:="Horário", Width:=70, Alignment:=0).Tag = ""
        
End With
 
    ListView_horario.ListItems.Clear
    lin = 2
    Range("A2").Select
    While ActiveCell <> ""
    Set Linha = ListView_horario.ListItems.Add(Text:=Sheets("HORÁRIO").Cells(lin, 1).Value) 'Código
    Linha.ListSubItems.Add Text:=Format(Sheets("HORÁRIO").Cells(lin, 2).Value, "hh:mm")
  
    
    lin = lin + 1
    ActiveCell.Offset(1, 0).Activate

Wend

' soma registros
    label_registros = Me.ListView_horario.ListItems.Count
    
' botão btn_editargravarhorario inicia invisivel
    btn_editargravarhorario.Visible = False
End Sub

Sub carregartextbox()
    
    With ListView_horario
    
    txt_idhorario.Text = .SelectedItem
    txt_horario.Text = Format(.SelectedItem.SubItems(1), "hh:mm")
    
    
    End With
    
    
    
End Sub

o Erro aparece nesta linha

Imagem

Se alguém já teve esse problema e tiver alguma dica agradeço.

Reinaldo · Mensagem por **Reinaldo** » Qua Jul 19, 2017 9:36 am

O "erro"ocorre por essa rotina:

Código: Selecionar todos

Private Sub ListView_horario_Click()
Call carregartextbox
End Sub

Ao clicar na listiview e disparado a sub rotina que carrega os dados

Código: Selecionar todos

Sub carregartextbox()

With ListView_horario
    txt_idhorario.Text = .SelectedItem
    txt_horario.Text = Format(.SelectedItem.SubItems(1), "hh:mm")
End With

End Sub

Como não há valor na listview a rotina retorna erro.

Voce pode: alterar a rotina para o evento dblClick ou

alterar seu evento +/- assim:

Código: Selecionar todos

Private Sub ListView_horario_Click()

On Error GoTo aqui

If ListView_horario.SelectedItem <> "" Then Call carregartextbox
End With
aqui:
If Err.Number = 91 Then
    MsgBox "Sem Valor"
    Exit Sub
End If
End Sub

carloseg · Mensagem por **carloseg** » Qua Jul 19, 2017 1:37 pm

Reinaldo fiz conforme sugerido e funcionou.

Grato

Carlos Eduardo

ERRO TEMPO DE EXECUÇÃO '91'

ERRO TEMPO DE EXECUÇÃO '91'

Re: ERRO TEMPO DE EXECUÇÃO '91'

Re: RESOLVIDO - ERRO TEMPO DE EXECUÇÃO '91'