Notifications
Clear all

Filtro de Pesquisa / Exportr Relatório

3 Posts
2 Usuários
0 Reactions
992 Visualizações
(@bilokas)
Posts: 168
Estimable Member
Topic starter
 

Olá queridos amigos do fórum, venho eu aqui mais uma vez pedir a ajuda dos nobres colegas.

Tenho um projeto para cadastro de férias de servidores aqui da SEFAZ-RJ (Secretaria de Estado de Fazenda) que está 90% pronto. O sistema tem que cadastrar, pesquisar e gerar relatórios de 5 tipos diferentes.

No meu código que eu aproveitei de outra planilha ele exibe o resultado do filtro em objetos. O que preciso é que ele exporte/cole o resultado na aba "relatorios" ao invés de exibir em objetos.
Eu tenho a seguinte rotina para fazer o filtro dos relatórios:

Private Sub ProcuraPersonalizada(ByVal TermoPesquisado As String, ByVal sPesquisarNoCampo As String)
Dim Busca As Range
Dim Primeira_Ocorrencia As String
Dim ResultadosLinha As String
Dim ResultadosPlanilha As String
Dim sSearchInCol As String
Dim arrPesquisarNasPlanilhas As Variant
Dim I As Integer
    'Define a Coluna onde a informação será pesquisada
    sSearchInCol = ConfigColunas(sPesquisarNoCampo)
    'Define as Planilhas onde a informação será pesquisada
    arrPesquisarNasPlanilhas = ConfigPlanilhasBase
    'Inicializa os resultados
    ResultadosLinha = ""
    ResultadosPlanilha = ""
    MatrizResultadosLinha = ""
    MatrizResultadosPlanilha = ""
    'Executa a busca
    For I = 0 To UBound(arrPesquisarNasPlanilhas)
        With Sheets(arrPesquisarNasPlanilhas(I))
            If sSearchInCol = "" Then
                Set Busca = .Cells.Find(What:=TermoPesquisado, After:=.Range("A1"), LookIn:=xlFormulas, _
                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)
            Else
                Set Busca = .Range(sSearchInCol & ":" & sSearchInCol).Find( _
                    What:=TermoPesquisado, _
                    After:=.Range(sSearchInCol & "1"), _
                    LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)
            End If
            'Caso tenha encontrado alguma ocorrência...
            If Not Busca Is Nothing Then
                Primeira_Ocorrencia = Busca.Address
                ResultadosLinha = ResultadosLinha & IIf((Len(ResultadosLinha) > 0), ";", "") & Busca.Row 'Lista o primeiro resultado na variavel - linha da ocorrência
                ResultadosPlanilha = ResultadosPlanilha & IIf((Len(ResultadosPlanilha) > 0), ";", "") & .Index 'Lista o primeiro resultado na variavel - planilha da ocorrência
                'Neste loop, pesquisa todas as próximas ocorrências para
                'o termo pesquisado
                Do
                    If sSearchInCol = "" Then
                        Set Busca = .Cells.FindNext(After:=Busca)
                    Else
                        Set Busca = .Range(sSearchInCol & ":" & sSearchInCol).FindNext(After:=Busca)
                    End If
                    'Condicional para não listar o primeiro resultado
                    'pois já foi listado acima
                    If Not Busca.Address Like Primeira_Ocorrencia Then
                        ResultadosLinha = ResultadosLinha & ";" & Busca.Row
                        ResultadosPlanilha = ResultadosPlanilha & ";" & .Index
                    End If
                Loop Until Busca.Address Like Primeira_Ocorrencia
            End If
        End With
    Next I
    
    If Len(ResultadosLinha) > 0 Then    'Se foram encontrados resultados
        MatrizResultadosLinha = Split(ResultadosLinha, ";")
        MatrizResultadosPlanilha = Split(ResultadosPlanilha, ";")
        'Atualiza dados iniciais no formulário
        SpinButton1.Max = UBound(MatrizResultadosLinha)  'Valor maximo do seletor de registros
        'habilita o seletor de registro
        SpinButton1.Enabled = True
        'indicador do seletor de registros
        Label_Registros_Contador.Caption = "1 de " & UBound(MatrizResultadosLinha) + 1
        'Box com o conteudo encontrado
        With Sheets(CInt(MatrizResultadosPlanilha(0)))
        
        
                txt_NomeCompleto.Text = .Cells(MatrizResultadosLinha(0), 1).Value
                txt_IDFuncional.Text = .Cells(MatrizResultadosLinha(0), 2).Value
                txt_Lotacao.Text = .Cells(MatrizResultadosLinha(0), 3).Value
                txt_Cargo.Text = .Cells(MatrizResultadosLinha(0), 4).Value
                
            End With
        MsgBox "Nenhum resultado para '" & TermoPesquisado & "' foi encontrado.", vbInformation, "AVISO"
    End If
End Sub


DGAF / DVGD - Divisão de Gestão de Documentos
Rafael A. Guimarães
[email protected]

 
Postado : 21/01/2014 11:56 am
(@bilokas)
Posts: 168
Estimable Member
Topic starter
 

Se eu conseguir exibir o resultado da pesquisa num ListBox também me ajuda a resolver o problema!


DGAF / DVGD - Divisão de Gestão de Documentos
Rafael A. Guimarães
[email protected]

 
Postado : 21/01/2014 12:50 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Em sua rotina de Cadastrar você já tem as instruções para jogar para a aba, seria o caso de adaptar esta da pesquisa, em vez de jogar o resultado para os controles jogar para a aba que quer.

Só não entendi que na aba dados temos 41 Colunas e na Relatorios só 13, de qualquer forma fiz a adaptação em algumas linhas da rotina até o Exercício 1, o restante é só ajustar da mesma forma.

O ideal é colocar um outro botão para jogar o resultado na Aba e manter o do resultado nos controles, logicamente alterando o nome da rotina, tipo "ProcuraPersonalizadaParaAba" e associar a este novo botão.

Uma outra obs, é que apesar de estarem como Private você tem rotina com o nome repetido, o ideal para evitar conflitos futuros é definir nomes diferentes, veja que no formulario "frmrelatorios" a rotina se repete.

Private Sub ProcuraPersonalizada(ByVal TermoPesquisado As String, ByVal sPesquisarNoCampo As String)
Dim Busca As Range
Dim Primeira_Ocorrencia As String
Dim ResultadosLinha As String
Dim ResultadosPlanilha As String
Dim sSearchInCol As String
Dim arrPesquisarNasPlanilhas As Variant
Dim I As Integer
    'Define a Coluna onde a informação será pesquisada
    sSearchInCol = ConfigColunas(sPesquisarNoCampo)
    'Define as Planilhas onde a informação será pesquisada
    arrPesquisarNasPlanilhas = ConfigPlanilhasBase
    'Inicializa os resultados
    ResultadosLinha = ""
    ResultadosPlanilha = ""
    MatrizResultadosLinha = ""
    MatrizResultadosPlanilha = ""
    'Executa a busca
    For I = 0 To UBound(arrPesquisarNasPlanilhas)
        With Sheets(arrPesquisarNasPlanilhas(I))
            If sSearchInCol = "" Then
                Set Busca = .Cells.Find(What:=TermoPesquisado, After:=.Range("A1"), LookIn:=xlFormulas, _
                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)
            Else
                Set Busca = .Range(sSearchInCol & ":" & sSearchInCol).Find( _
                    What:=TermoPesquisado, _
                    After:=.Range(sSearchInCol & "1"), _
                    LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)
            End If
            'Caso tenha encontrado alguma ocorrência...
            If Not Busca Is Nothing Then
                Primeira_Ocorrencia = Busca.Address
                ResultadosLinha = ResultadosLinha & IIf((Len(ResultadosLinha) > 0), ";", "") & Busca.Row 'Lista o primeiro resultado na variavel - linha da ocorrência
                ResultadosPlanilha = ResultadosPlanilha & IIf((Len(ResultadosPlanilha) > 0), ";", "") & .Index 'Lista o primeiro resultado na variavel - planilha da ocorrência
                'Neste loop, pesquisa todas as próximas ocorrências para
                'o termo pesquisado
                Do
                    If sSearchInCol = "" Then
                        Set Busca = .Cells.FindNext(After:=Busca)
                    Else
                        Set Busca = .Range(sSearchInCol & ":" & sSearchInCol).FindNext(After:=Busca)
                    End If
                    'Condicional para não listar o primeiro resultado
                    'pois já foi listado acima
                    If Not Busca.Address Like Primeira_Ocorrencia Then
                        ResultadosLinha = ResultadosLinha & ";" & Busca.Row
                        ResultadosPlanilha = ResultadosPlanilha & ";" & .Index
                    End If
                Loop Until Busca.Address Like Primeira_Ocorrencia
            End If
        End With
    Next I
    
    
'INICIO RESULTADO NA ABA RELATORIOS =========================================================================
    If Len(ResultadosLinha) > 0 Then    'Se foram encontrados resultados
    
        MatrizResultadosLinha = Split(ResultadosLinha, ";")
        MatrizResultadosPlanilha = Split(ResultadosPlanilha, ";")
        'Atualiza dados iniciais no formulário
        SpinButton1.Max = UBound(MatrizResultadosLinha)  'Valor maximo do seletor de registros
        'habilita o seletor de registro
        SpinButton1.Enabled = True
        'indicador do seletor de registros
        Label_Registros_Contador.Caption = "1 de " & UBound(MatrizResultadosLinha) + 1
        'Box com o conteudo encontrado
        

'Definimos a Sheet
Dim wsRelatorio As Worksheet

'Definimos Aba relatorios
Set wsRelatorio = Worksheets("relatorios")
    
'Verifica qual a ultima Linha preenchida na coluna A
'Descontando a primeira linha de cabeçalho
lastRow = wsRelatorio.Cells(Rows.Count, 1).End(xlUp).Row + 1
        
        With Sheets(CInt(MatrizResultadosPlanilha(0)))
        
            'Dados cadastrais
            wsRelatorio.Cells(lastRow, 1).Value = .Cells(MatrizResultadosLinha(0), 1).Value
            wsRelatorio.Cells(lastRow, 2).Value = .Cells(MatrizResultadosLinha(0), 2).Value
            wsRelatorio.Cells(lastRow, 3).Value = .Cells(MatrizResultadosLinha(0), 3).Value
            wsRelatorio.Cells(lastRow, 4).Value = .Cells(MatrizResultadosLinha(0), 4).Value
                
                'Status do servidor
                If .Cells(MatrizResultadosLinha(0), 5).Value = "ATIVO" Then
                    'OptionButton_Ativo.Value = True
                    wsRelatorio.Cells(lastRow, 5).Value = "ATIVO"
                Else
                If .Cells(MatrizResultadosLinha(0), 5).Value = "LICENÇA" Then
                    wsRelatorio.Cells(lastRow, 6).Value = "LICENÇA"
                Else
                If .Cells(MatrizResultadosLinha(0), 5).Value = "APOSENTADO" Then
                    wsRelatorio.Cells(lastRow, 7).Value = "APOSENTADO"
                End If
                End If
                End If
                
                'Data status do servidor
                wsRelatorio.Cells(lastRow, 8).Value = .Cells(MatrizResultadosLinha(0), 6).Value
                wsRelatorio.Cells(lastRow, 9).Value = .Cells(MatrizResultadosLinha(0), 7).Value
                wsRelatorio.Cells(lastRow, 10).Value = .Cells(MatrizResultadosLinha(0), 8).Value
                
                'Período indeferido
                If .Cells(MatrizResultadosLinha(0), 9).Value = "SIM" Then
                    wsRelatorio.Cells(lastRow, 11).Value = "SIM"
                Else
                If .Cells(MatrizResultadosLinha(0), 9).Value = "NÃO" Then
                    wsRelatorio.Cells(lastRow, 12).Value = "NÃO"
                End If
                End If
                
                'Pelo Processo
                wsRelatorio.Cells(lastRow, 13).Value = .Cells(MatrizResultadosLinha(0), 10).Value
                'Contato em dobro
                If .Cells(MatrizResultadosLinha(0), 11).Value = "SIM" Then
                    wsRelatorio.Cells(lastRow, 14).Value = "SIM"
                Else
                If .Cells(MatrizResultadosLinha(0), 11).Value = "NÃO" Then
                    wsRelatorio.Cells(lastRow, 14).Value = "NÃO"
                End If
                End If
                
                'Exercício 1
                wsRelatorio.Cells(lastRow, 15).Value = .Cells(MatrizResultadosLinha(0), 12).Value
                wsRelatorio.Cells(lastRow, 16).Value = .Cells(MatrizResultadosLinha(0), 13).Value
                wsRelatorio.Cells(lastRow, 17).Value = .Cells(MatrizResultadosLinha(0), 14).Value
                wsRelatorio.Cells(lastRow, 18).Value = .Cells(MatrizResultadosLinha(0), 15).Value
                
                'Exercício 2
                    '........
                    '.........
                    '..........
                
                
            End With
        
        btn_Editar.Enabled = True
        btn_Excluir.Enabled = True
        
'FIM RESULTADO NA ABA RELATORIOS ==================================================================

'Desta linha para baixo não alterei nada    
    Else    'Caso nada tenha sido encontrado, exibe mensagem informativa

Qualquer duvida retorne.

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 21/01/2014 7:11 pm