Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Worksheet Temporári...
 
Notifications
Clear all

Worksheet Temporário para Pesquisa

 
2024 - VBA & Macros
Post Recente por carloshvb 10 anos atrás
10 Posts
3 Usuários
0 Reactions
1,501 Visualizações
RSS
 carloshvb
(@carloshvb)
Posts: 0
New Member
Topic starter
 

Boa tarde Pessoa,

Estou desenvolvendo um BD em Excel para a empresa todo baseado em formulários e mantendo as planilhas ocultas para o usuário.

O caso é o seguinte, neste BD, eu tenho o formulário de Inclusão (está OK) que grava os valores na planilha "Dados".
Tenho o formulário de Pesquisa que consulta os valores na Planilha "Dados" e exibe em uma listview. Ao dar duplo clique no resultado da listview ele abre um formulário que exibe os valores do item clicado e tem botões de navegação que permitem ver os outros registros da Planilha "Dados"

O que eu preciso é que ao fazer a pesquisa, seja criada uma nova planilha temporária somente com os dados da listview e que meu formulário de consulta navegue apenas nesta planilha temporária e ao fechar o formulário de consulta está planilha temporária seja deletada.

Isso é possível? Como faço?

Desde já, obrigado.

 
Postado : 10/04/2015 11:01 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Sem ver sua rotina fica complicado, mas geralmente uma boa ideia é listar os dados filtrando uma determinada guia e depois mostrar no ListView, vamos considerar que está assim....

Então vá na guia que filtrou os dados (que consequentemente mostrar no listview), então cope e cole em uma nova guia.

Usando 

.SpecialCells(xlCellTypeVisible).Copy

Leia:
http://www.ozgrid.com/Excel/free-traini ... sson20.htm

Att

 
Postado : 10/04/2015 12:19 pm
 carloshvb
(@carloshvb)
Posts: 0
New Member
Topic starter
 

Bom dia Alexandre,

Segue abaixo os códigos dos formulários para avaliação:

Código do Formulário de Pesquisa:

Private Const NomePlanSaida As String = "Dados"
Private Const LinhaCabecalho As Integer = 1

'INICIO EVENTOS FORMATAÇÃO DOS TEXTBOX DATAS
        Private Sub dataf_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
            'Limita a Qde de caracteres
            dataf.MaxLength = 10
           
            'para permitir que apenas números sejam digitados
            If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
                KeyAscii = 0
            End If
        End Sub

        Private Sub dataf_Change()
            'Formata : dd/mm/aaaa
            If Len(dataf) = 2 Or Len(dataf) = 5 Then
                dataf.Text = dataf.Text & "/"
                SendKeys "{End}", True
            End If
        End Sub

        Private Sub datai_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
            'Limita a Qde de caracteres
            datai.MaxLength = 10
           
            'para permitir que apenas números sejam digitados
            If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
                KeyAscii = 0
            End If
        End Sub

        Private Sub datai_Change()
            'Formata : dd/mm/aaaa
            If Len(datai) = 2 Or Len(datai) = 5 Then
                datai.Text = datai.Text & "/"
                SendKeys "{End}", True
            End If
    End Sub
'FIM EVENTOS FORMATAÇÃO DOS TEXTBOX DATAS

Private Sub UserForm_Activate()

    'Set a reference to Microsoft Windows Common Controls by
    'using Tools > References in the Visual Basic Editor (Alt+F11)

    'Define algumas propriedades do ListView
    With Me.lstLista
        .Gridlines = True
        .HideColumnHeaders = False
        .View = lvwReport
    End With
    
    'Preenche Combo Box
    setor.AddItem ""
    setor.AddItem "Administração"
    setor.AddItem "CD 2"
    setor.AddItem "HPBE"
    setor.AddItem "Logistica"
    setor.AddItem "Manutenção"
    setor.AddItem "Meio Ambiente"
    setor.AddItem "PCP"
    setor.AddItem "Qualidade"
    setor.AddItem "Segurança"
    setor.AddItem "SMBE"
    setor.ListIndex = 0
    
    'Chama a sub para preencher a ListView
    Call LoadListView
    
End Sub

Sub RestauraControles()

    datai.Value = ""
    dataf.Value = ""
    nome.Value = ""
       
    Call LoadListView
    nome.SetFocus
    
End Sub

Private Sub limpa_Click()

    RestauraControles
    
End Sub

Private Sub fechar_Click()

    Unload cmsPesquisa

End Sub

'Preenche a ListView
Private Sub LoadListView()

        Dim ws As Worksheet
        Dim coluna As Integer
        Dim linha As Integer
        Dim itm As ListItem, n As Long, lngCol As Long
        Dim vardata As Variant
        
        Set ws = ThisWorkbook.Worksheets(NomePlanSaida)
        
            coluna = 1
            linha = LinhaCabecalho
            
            Me.lstLista.ListItems.Clear
            Me.lstLista.ColumnHeaders.Clear
        
        vardata = ws.Range("A1").CurrentRegion.Value
        
        With ws
            While .Cells(linha, coluna).Value <> Empty
                   With lstLista
                     .View = lvwReport
                     .Gridlines = True
                     .ColumnHeaders.Add Text:=ws.Cells(linha, coluna), Width:=ws.Cells(linha, coluna).Width
                   
                   End With
                coluna = coluna + 1
            Wend
            
            'Preenche as Linhas
            With lstLista
                    For n = 2 To UBound(vardata)
                        Set itm = .ListItems.Add(n - 1, , vardata(n, 1))
                            For lngCol = 2 To UBound(vardata, 2)
                        
                                'verifica se é Data e formata a Coluna
                                If IsDate(vardata(n, lngCol)) Then
                                    itm.ListSubItems.Add , , Format(vardata(n, lngCol), "dd/mm/yyyy")
                                Else
                                    itm.ListSubItems.Add , , vardata(n, lngCol)
                                End If
                            
                            Next lngCol
                    Next n
                End With
            
        End With

    End Sub

 'Consulta Nome
Sub nome_Change()

          lastRow = Plan2.Cells(Rows.Count, "a").End(xlUp).Row
          lstLista.ListItems.Clear
          
         'Adiciona itens
        For x = 2 To lastRow
            If UCase(Plan2.Cells(x, 2)) Like "*" & UCase(nome) & "*" Then
                Set li = lstLista.ListItems.Add(Text:=Plan2.Cells(x, "a").Value)
                li.ListSubItems.Add Text:=Plan2.Cells(x, "b").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "c").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "d").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "e").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "f").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "g").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "h").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "i").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "j").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "k").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "l").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "m").Value
            End If
        Next
    End Sub
    
    'Consulta Área de Impacto
Sub setor_Change()

          lastRow = Plan2.Cells(Rows.Count, "a").End(xlUp).Row
          lstLista.ListItems.Clear
          
         'Adiciona itens
        For x = 2 To lastRow
            If UCase(Plan2.Cells(x, 4)) Like "*" & UCase(setor) & "*" Then
                Set li = lstLista.ListItems.Add(Text:=Plan2.Cells(x, "a").Value)
                li.ListSubItems.Add Text:=Plan2.Cells(x, "b").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "c").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "d").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "e").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "f").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "g").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "h").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "i").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "j").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "k").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "l").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "m").Value
            End If
        Next
    End Sub

'Filtrar pelas Datas
Private Sub cbtSo2Dts_Click()
    Dim i As Long
        
        If datai = "" Then
                MsgBox "Digite uma Data Valida", , "Data Inicial Obrigatória!!!"
                datai.SetFocus
            Exit Sub
        End If
        
        For i = lstLista.ListItems.Count To 1 Step -1
            If CDate(lstLista.ListItems(i).SubItems(5)) < datai.Value Then
                lstLista.ListItems.Remove i
            ElseIf CDate(lstLista.ListItems(i).SubItems(5)) > dataf.Value Then
                lstLista.ListItems.Remove i
            End If
        Next

End Sub

' É AQUI ONDE EU GOSTARIA DE INSERIR O CÓDIGO PARA PEGAR OS DADOS DO LISTVIEW E GERAR UMA NOVA PLANILHA E ENTÃO ENVIAR ESTES DADOS PARA O FORMULÁRIO DE PESQUISA

' Carrega o cadastro selecionado  no formulário de consulta de cadastro
Private Sub lstLista_DblClick()
Dim linha, Index
Dim i As Integer
Dim oList As Object
Dim indiceRegistro As Long


Set oList = lstLista.SelectedItem
    
    If oList Is Nothing Then
     Exit Sub
   
     Else
            indiceRegistro = cmsCadastro.ProcuraIndiceRegistroPodId(lstLista.ListItems.Item(lstLista.SelectedItem.Index))
                     If indiceRegistro <> -1 Then
                        Call cmsCadastro.CarregaRegistroPorIndice(indiceRegistro)
                    End If
             Unload Me
             cmsCadastro.Show
    End If
End Sub

E este é o código do formulário de consulta de cadastro:

Option Explicit

Const colIdeiaN As Integer = 1
Const colNome As Integer = 2
Const colFuncao As Integer = 3
Const colSetor As Integer = 4
Const colEmail As Integer = 5
Const colData As Integer = 6
Const colIdeia As Integer = 7
Const colExplicacao As Integer = 8
Const colExpectativa As Integer = 9
Const colComentarioG As Integer = 10
Const colValidacao As Integer = 11
Const colComentarioA As Integer = 12
Const colFeedBack As Integer = 13
Const indiceMinimo As Byte = 2
Const nomePlanilhaCadastro As String = "Dados"

Private wsCadastro As Worksheet
Private indiceRegistro As Long

' Procedimentos Iniciais
Private Sub UserForm_Initialize()
    
    Call DefinePlanilhaDados
    Call LimpaRegistro
    validacao.AddItem "Aprovado"
    validacao.AddItem "Banco de Ideias"
    validacao.AddItem "Aguardando análise da Comissão"
    validacao.ListIndex = 2
    
End Sub

' Abre Pesquisa
Private Sub npesquisa_Click()
    
    Call LimpaRegistro
    Unload Me
    cmsPesquisa.Show
    
End Sub

Private Sub fechar_Click()

    Unload cmsCadastro

End Sub

Private Sub LimpaRegistro()
'limpa os dados ao abrir o form
            ideian.Value = ""
            nome.Value = ""
            funcao.Value = ""
            setor.Value = ""
            mail.Value = ""
            data.Value = ""
            ideia.Value = ""
            explicacao.Value = ""
            expectativa.Value = ""
            comentario.Value = ""
            validacao.Value = ""
            comentariosad.Value = ""
            feedback.Value = ""
       
End Sub

Private Sub CarregaRegistro()
'carrega os dados do primeiro registro
    With wsCadastro
        If Not IsEmpty(.Cells(indiceRegistro, colIdeiaN)) Then
            Me.ideian.Text = .Cells(indiceRegistro, colIdeiaN).Value
            Me.nome.Text = .Cells(indiceRegistro, colNome).Value
            Me.funcao.Text = .Cells(indiceRegistro, colFuncao).Value
            Me.setor.Text = .Cells(indiceRegistro, colSetor).Value
            Me.mail.Text = .Cells(indiceRegistro, colEmail).Value
            Me.data.Text = .Cells(indiceRegistro, colData).Value
            Me.ideia.Text = .Cells(indiceRegistro, colIdeia).Value
            Me.explicacao.Text = .Cells(indiceRegistro, colExplicacao).Value
            Me.expectativa.Text = .Cells(indiceRegistro, colExpectativa).Value
            Me.comentario.Text = .Cells(indiceRegistro, colComentarioG).Value
            Me.validacao.Text = .Cells(indiceRegistro, colValidacao).Value
            Me.comentariosad.Text = .Cells(indiceRegistro, colComentarioA).Value
            Me.feedback.Text = .Cells(indiceRegistro, colFeedBack).Value
        End If
    End With

End Sub

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

    Call CarregaRegistro
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, colIdeiaN))
            If .Cells(i, colIdeiaN).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()
    
    Set wsCadastro = Worksheets(nomePlanilhaCadastro)
        
End Sub
Private Sub salvar_Click()
    Call SalvaRegistro(CLng(ideian.Text), indiceRegistro)
End Sub

Private Sub SalvaRegistro(ByVal id As Long, ByVal indice As Long)
        
    With wsCadastro
        .Cells(indice, colIdeiaN).Value = id
        .Cells(indice, colValidacao).Value = Me.validacao.Text
        .Cells(indice, colComentarioA).Value = Me.comentariosad.Text
        .Cells(indice, colFeedBack).Value = Me.feedback.Text
    End With
    
    'Salva o arquivo
    ActiveWorkbook.Save
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

Após o fechamento deste formulário eu preciso que os dados da planilha temporária sejam apagados

Desde já, obrigado pela ajuda

 
Postado : 13/04/2015 6:01 am
 Edcronos
(@edcronos)
Posts: 1006
Noble Member
 

carloshvb

o ideal para ser ajudado é criar uma planilha de exemplo com alguns dados
isso facilita visualizar oq vc quer

algumas coisas podem até ser simples, mas pode ficar ainda mais simples tendo onde testar
as pessoas as vezes até desistem de ajudar pq teria que montar uma planilha para isso

sem isso, só se pode esperar respostas vagas

 
Postado : 13/04/2015 6:55 am
 carloshvb
(@carloshvb)
Posts: 0
New Member
Topic starter
 

Pessoal, depois de alguma pesquisa encontrei parte da solução:

Eu usei o código abaixo para preencher a planilha DadosTemp ao dar Duplo Clique em um item da Listview:

Private Sub PlanTmp()
    Dim iLin As Integer
    Dim rgCellInicio As Range
    Dim wsRelat As Worksheet
    Dim UltimaLinha As Long
    
    Set wsRelat = ThisWorkbook.Worksheets(NomePlanRelatorio)

    UltimaLinha = wsRelat.UsedRange.Rows.Count
    
    wsRelat.Range("A2:" & "M" & UltimaLinha).ClearContents
    
    Set rgCellInicio = wsRelat.Range("A65536").End(xlUp).Offset(1, 0)

        'recuperar dados
         Dim I As Integer, j As Integer
            
            'Loop nas linhas
            For I = 1 To lstLista.ListItems.Count
                
                iLin = iLin + 1
                
                        rgCellInicio.Cells(iLin, 1).Value = lstLista.ListItems(I).Text
                
                    'Loop nas colunas
                    For j = 1 To lstLista.ColumnHeaders.Count - 1
                        rgCellInicio.Cells(iLin, j + 1).Value = lstLista.ListItems(I).ListSubItems(j).Text
                    Next j
            Next I
    
       
End Sub

' Carrega o cadastro selecionado
Private Sub lstLista_DblClick()
Dim linha, Index
Dim I As Integer
Dim oList As Object
Dim indiceRegistro As Long

Call PlanTmp

Set oList = lstLista.SelectedItem
    
    If oList Is Nothing Then
     Exit Sub
   
     Else
            indiceRegistro = cmsCadastro.ProcuraIndiceRegistroPodId(lstLista.ListItems.Item(lstLista.SelectedItem.Index))
                     If indiceRegistro <> -1 Then
                        Call cmsCadastro.CarregaRegistroPorIndice(indiceRegistro)
                    End If
             Unload Me
             cmsCadastro.Show
    End If
End Sub

Porem, quando quando a Listview é preenchida através do código:

 'Consulta Nome
Sub nome_Change()

          lastRow = Plan2.Cells(Rows.Count, "a").End(xlUp).Row
          lstLista.ListItems.Clear
          
         'Adiciona itens
        For x = 2 To lastRow
            If UCase(Plan2.Cells(x, 2)) Like "*" & UCase(nome) & "*" Then
                Set li = lstLista.ListItems.Add(Text:=Plan2.Cells(x, "a").Value)
                li.ListSubItems.Add Text:=Plan2.Cells(x, "b").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "c").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "d").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "e").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "f").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "g").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "h").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "i").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "j").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "k").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "l").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "m").Value
            End If
        Next
    End Sub

Eu recebo o Erro: 35600 - Index out of Bound, ao dar o Duplo clique no item da listview

E acusa erro neste código:

 rgCellInicio.Cells(iLin, j + 1).Value = lstLista.ListItems(I).ListSubItems(j).Text

E preenche apenas o primeiro valor da planilha DadosTemp

Tem como resolver isso?

Conforme solicitado pelo Edcronos estou anexando meu programa.
OBS1: PARA REEXIBIR A PLANILHA QUE É OCULTADA AO ABRIR tem um botãozinho bem no canto inferior direito: a SENHA É: 53nhad03xc3l
OBS2: Eu quero fazer isso apenas para os formulários da "Área da Comissão" (cmsPesquisa e cmsCadastro). Senha da "Área da Comissão: comissao
OBS3: Preciso que os botões de navegação do formulário cmsCadastro naveguem pelos dados da planilha 'DadosTemp" mas grave as alterações no item correspondente da planilha "Dados"

Desde já agradeço a ajuda.

 
Postado : 13/04/2015 7:26 am
 Edcronos
(@edcronos)
Posts: 1006
Noble Member
 

era para ser uma planilha de exemplo com as partes que vc já conseguiu para conserto ou implementação

tem como vc deixar apenas macros e abas envolvidas com o pedido?

fica dificil se achar com um projeto completo "pelo menos para mim"

 
Postado : 13/04/2015 8:07 am
 carloshvb
(@carloshvb)
Posts: 0
New Member
Topic starter
 

ATUALIZANDO

Pessoal, já consegui fazer o formulário cmsCadastro navegar apenas pelos dados da Planilha "DadosTemp"

Agora só preciso resolver o problema que ocorre quando faço a pesquisa que usa o "nome_Change" e o problema de gravar os dados na planilha "Dados"
Da forma que eu tentei, os dados estão sendo gravados no item errado, preciso de um código que faça com que a linha onde vou gravar os dados na Planilha "Dados" seja igual ao valor do campo "ideian + 1". Acredito que isso resolva meu problema, mas como estou adaptando os códigos e estudando VBA por conta na internet eu ainda não consegui fazer isso.

Também estou reupando o programa com as alterações que fiz.

 
Postado : 13/04/2015 8:26 am
 carloshvb
(@carloshvb)
Posts: 0
New Member
Topic starter
 

era para ser uma planilha de exemplo com as partes que vc já conseguiu para conserto ou implementação

tem como vc deixar apenas macros e abas envolvidas com o pedido?

fica dificil se achar com um projeto completo "pelo menos para mim"

Edcronos, meu pedido está relacionado apenas com os formulários cmsPesquisa e cmsCadastro, o restante já está OK (eu espero).

 
Postado : 13/04/2015 8:28 am
 Edcronos
(@edcronos)
Posts: 1006
Noble Member
 

sim, o seu pedido está relacionado com ...
os formulários cmsPesquisa e cmsCadastro e as abas relacionadas

se todo o restantes não faz parte do seu pedido, apenas dificulta o entendimento do que vc quer e a implementação
então, eu posso tentar te ajudar,
mas infelizmente não disponho de conhecimento suficiente para filtrar as coisas que não são relacionadas ao seu pedido

 
Postado : 13/04/2015 8:37 am
 carloshvb
(@carloshvb)
Posts: 0
New Member
Topic starter
 

Bom dia Pessoal,

Meu caso é o seguinte:

Tenho um formulário de Pesquisa que filtra os dados de uma planilha, "Dados", para uma listview neste formulário.

A pesquisa é feita de duas formas por data e por nome. E ao dar um Duplo Clique em um dos itens da listview, os dados do listview são copiados para outra planilha, DadosTemp" e um novo formulário se abre com os dados do item clicado já carregados.

Quando faço a pesquisa por data, não tem problema, tudo ocorre como deveria.

Meu problema é quando faço a pesquisa por nome.

Este é o código da pesquisa por nome:

'Consulta Nome'
Sub nome_Change()

          lastRow = Plan2.Cells(Rows.Count, "a").End(xlUp).Row
          lstLista.ListItems.Clear
          
         'Adiciona itens'
        For x = 2 To lastRow
            If UCase(Plan2.Cells(x, 2)) Like "*" & UCase(nome) & "*" Then
                Set li = lstLista.ListItems.Add(Text:=Plan2.Cells(x, "a").Value)
                li.ListSubItems.Add Text:=Plan2.Cells(x, "b").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "c").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "d").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "e").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "f").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "g").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "h").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "i").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "j").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "k").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "l").Value
                li.ListSubItems.Add Text:=Plan2.Cells(x, "m").Value
            End If
        Next
    End Sub

Este é o código que abre o novo formulário e chama a rotina de copiar os dados para a planilha "DadosTemp":

' Carrega o cadastro selecionado'
Private Sub lstLista_DblClick()
Dim linha, Index
Dim I As Integer
Dim oList As Object
Dim indiceRegistro As Long

Call PlanTmp

Set oList = lstLista.SelectedItem
    
    If oList Is Nothing Then
     Exit Sub
   
     Else
            indiceRegistro = cmsCadastro.ProcuraIndiceRegistroPodId(lstLista.ListItems.Item(lstLista.SelectedItem.Index))
                     If indiceRegistro <> -1 Then
                        Call cmsCadastro.CarregaRegistroPorIndice(indiceRegistro)
                    End If
             Unload Me
    End If
    cmsCadastro.Show
End Sub

Este é o código da rotina de cópia dos dados para a planilha "DadosTemp"

Private Sub PlanTmp()
    Dim iLin As Integer
    Dim rgCellInicio As Range
    Dim wsRelat As Worksheet
    Dim UltimaLinha As Long
    Set wsRelat = ThisWorkbook.Worksheets(NomePlanRelatorio)
    UltimaLinha = wsRelat.UsedRange.Rows.Count
    wsRelat.Range("A2:" & "M" & UltimaLinha).ClearContents
    Set rgCellInicio = wsRelat.Range("A65536").End(xlUp).Offset(1, 0)

        'recuperar dados'
         Dim I As Integer, j As Integer
            
            'Loop nas linhas'
            For I = 1 To lstLista.ListItems.Count
                
                iLin = iLin + 1
                
                        rgCellInicio.Cells(iLin, 1).Value = lstLista.ListItems(I).Text
                
                    'Loop nas colunas'
                    For j = 1 To lstLista.ColumnHeaders.Count - 1
                        rgCellInicio.Cells(iLin, j + 1).Value = lstLista.ListItems(I).ListSubItems(j).Text
                    Next j
            Next I
End Sub

E aqui é onde ocorre o erro "35600 - Index out of Bound" dentro do código de copia dos dados:

 For j = 1 To lstLista.ColumnHeaders.Count - 1
                        rgCellInicio.Cells(iLin, j + 1).Value = lstLista.ListItems(I).ListSubItems(j).Text 'Está é a linha que dá erro
                    Next j

Então: quando preencho a listview utilizando o código acima "Sub nome_Change()..." esse erro (Index out of Bound) acontece, já quando uso o código abaixo, tudo acontece como deveria, o que posso fazer para corrigir isso?

Código de pesquisa por data que funciona corretamente:

'Filtrar pelas Datas'
Private Sub cbtSo2Dts_Click()
    Dim I As Long
        
        For I = lstLista.ListItems.Count To 1 Step -1
            If CDate(lstLista.ListItems(I).SubItems(5)) < datai.Value Then
                lstLista.ListItems.Remove I
            ElseIf CDate(lstLista.ListItems(I).SubItems(5)) > dataf.Value Then
                lstLista.ListItems.Remove I
            End If
        Next

End Sub

Desde já, obrigado pela ajuda

 
Postado : 14/04/2015 6:23 am
Forum Jump:
  Tópico Anterior
Próximo Tópico