Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Auto executar e filtro por aba

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
Diego_moreira
Colaborador
Colaborador
Mensagens: 23
Registrado em: Seg Mai 21, 2012 10:15 am

Auto executar e filtro por aba

Mensagem por Diego_moreira »

Olá pessoal!

Gostaria que me ajudassem a melhorar a macro que postei abaixo.
1° - Preciso adicionar um filtro no campo de pesquisa, para que eu possa selecionar a aba onde a pesquisa deve se restringir.
2° - Preciso que a macro se auto execute quando a planilha for aberta.

Desde já, agradeço a sua atenção.

Código: Selecionar todos

Public MatrizResultadosLinha As Variant
Public MatrizResultadosPlanilha As Variant
Public Total_Ocorrencias As Long
Public sCriterioDaBusca As String
Public sAcaoRequerida As String


Private Sub btn_Adicionar_Click()
    
    'Definir a ação do comando
    sAcaoRequerida = "Adicionar"
    
    'Habilitar Botões Salvar/Cancelar
    Call HabilitarControlesParaEdicao(True)
    
    
End Sub

Private Sub btn_Cancelar_Click()
    
    'Definir a ação do comando
    sAcaoRequerida = ""
    
    'Habilitar Botões Salvar/Cancelar
    Call HabilitarControlesParaEdicao(False)
    
    'Recarrega os controles com os valores ativos na memória
    Call SpinButton1_Change
    
    txt_Procurar.Text = sCriterioDaBusca
    
End Sub

Private Sub btn_Editar_Click()
    
    'Definir a ação do comando
    sAcaoRequerida = "Editar"
    
    'Habilitar Botões Salvar/Cancelar
    Call HabilitarControlesParaEdicao(True)
    
End Sub

Private Sub btn_Excluir_Click()
Dim sLinha As Long
Dim iPlanilha As Integer

    If MsgBox("Tem certeza que deseja eliminar este cadastro do sistema?", vbDefaultButton2 + vbQuestion + vbYesNo, Me.Caption) = vbYes Then
        sLinha = MatrizResultadosLinha(SpinButton1.Value)
        iPlanilha = MatrizResultadosPlanilha(SpinButton1.Value)
        
        'Exclui a linha do registro
        Sheets(iPlanilha).Rows(sLinha).Delete
        
        'Salva o arquivo
        ThisWorkbook.Save
        
        'Recarrega os registros para o formulário
        txt_Procurar.Text = sCriterioDaBusca
        Call ProcuraPersonalizada(sCriterioDaBusca, ComboBox1.Text)
    End If
    
End Sub

Private Sub btn_Procurar_Click()

    If txt_Procurar.Text = "" Then
        MsgBox "Digite um valor para a pesquisa"
    Else
        sCriterioDaBusca = txt_Procurar.Text
        Call ProcuraPersonalizada(sCriterioDaBusca, ComboBox1.Text)
    End If
    
End Sub

Private Sub btn_Salvar_Click()
Dim sLinha As Long
Dim iPlanilha As Integer

    'Realiza a ação apropriada
    Select Case sAcaoRequerida
        Case "Adicionar"
            With Sheets(Combo_OndeSalvar.Text)
                sLinha = .Range("A1").SpecialCells(xlLastCell).Row + 1  'Pega a próxima linha vazia para cadastrar novo
                'Grava os novos valores informados no formulário para a planilha base de dados
                .Cells(sLinha, 1).Value = TextBox1.Text
                .Cells(sLinha, 2).Value = TextBox2.Text
                .Cells(sLinha, 3).Value = TextBox3.Text
                .Cells(sLinha, 4).Value = TextBox4.Text
                .Cells(sLinha, 5).Value = TextBox5.Text
                .Cells(sLinha, 6).Value = TextBox6.Text
                .Cells(sLinha, 8).Value = TextBox7.Text
                .Cells(sLinha, 9).Value = TextBox8.Text
                .Cells(sLinha, 10).Value = TextBox9.Text
                .Cells(sLinha, 11).Value = TextBox10.Text

           End With
        Case "Editar"
            sLinha = MatrizResultadosLinha(SpinButton1.Value)
            iPlanilha = MatrizResultadosPlanilha(SpinButton1.Value)
            
            With Sheets(iPlanilha)
                'Atualiza os dados na linha de registro específica
                .Cells(sLinha, 1).Value = TextBox1.Text
                .Cells(sLinha, 2).Value = TextBox2.Text
                .Cells(sLinha, 3).Value = TextBox3.Text
                .Cells(sLinha, 4).Value = TextBox4.Text
                .Cells(sLinha, 5).Value = TextBox5.Text
                .Cells(sLinha, 6).Value = TextBox6.Text
                .Cells(sLinha, 8).Value = TextBox7.Text
                .Cells(sLinha, 9).Value = TextBox8.Text
                .Cells(sLinha, 10).Value = TextBox9.Text
                .Cells(sLinha, 11).Value = TextBox10.Text

           End With
        Case Else
            Exit Sub
    End Select
    
    'Definir a ação do comando
    sAcaoRequerida = ""
    
    'Habilitar Botões Salvar/Cancelar
    Call HabilitarControlesParaEdicao(False)
    
    'Recarrega os valores da pesquisa para exibir no formulário
    If sCriterioDaBusca <> "" Then
        txt_Procurar.Text = sCriterioDaBusca
        Call ProcuraPersonalizada(sCriterioDaBusca, ComboBox1.Text)
    End If
    
    'Salva o arquivo
    ThisWorkbook.Save
    
End Sub

Private Sub SpinButton1_Change()
Dim sLinha As Long
Dim iPlanilha As Integer
Dim TotalOcorrencias As Long

    If IsArray(MatrizResultadosLinha) Then  'Verifica se há informações de busca na matriz de resultados
                                            'Se houver dados retornados da busca, então carrega no formulário
        TotalOcorrencias = SpinButton1.Max + 1
        sLinha = MatrizResultadosLinha(SpinButton1.Value)
        iPlanilha = MatrizResultadosPlanilha(SpinButton1.Value)
        
        Label_Registros_Contador.Caption = SpinButton1.Value + 1 & " de " & TotalOcorrencias
        
        With Sheets(iPlanilha)
            Label_PlanBase.Caption = "Em " & .Name
            TextBox1.Text = .Cells(sLinha, 1).Value
            TextBox2.Text = .Cells(sLinha, 2).Value
            TextBox3.Text = .Cells(sLinha, 3).Value
            TextBox4.Text = .Cells(sLinha, 4).Value
            TextBox5.Text = .Cells(sLinha, 5).Value
            TextBox6.Text = .Cells(sLinha, 6).Value
            TextBox7.Text = .Cells(sLinha, 8).Value
            TextBox8.Text = .Cells(sLinha, 9).Value
            TextBox9.Text = .Cells(sLinha, 10).Value
            TextBox10.Text = .Cells(sLinha, 11).Value

        End With
    End If
    
End Sub


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)))
            Label_PlanBase.Caption = "Em " & .Name
            TextBox1.Text = .Cells(MatrizResultadosLinha(0), 1).Value
            TextBox2.Text = .Cells(MatrizResultadosLinha(0), 2).Value
            TextBox3.Text = .Cells(MatrizResultadosLinha(0), 3).Value
            TextBox4.Text = .Cells(MatrizResultadosLinha(0), 4).Value
            TextBox5.Text = .Cells(MatrizResultadosLinha(0), 5).Value
            TextBox6.Text = .Cells(MatrizResultadosLinha(0), 6).Value
            TextBox7.Text = .Cells(MatrizResultadosLinha(0), 8).Value
            TextBox8.Text = .Cells(MatrizResultadosLinha(0), 9).Value
            TextBox9.Text = .Cells(MatrizResultadosLinha(0), 10).Value
            TextBox10.Text = .Cells(MatrizResultadosLinha(0), 11).Value

        End With
        
        btn_Editar.Enabled = True
        btn_Excluir.Enabled = True
    
    Else    'Caso nada tenha sido encontrado, exibe mensagem informativa
    
        SpinButton1.Enabled = False     'desabilita o seletor de registros
        btn_Editar.Enabled = False
        btn_Excluir.Enabled = False
        Label_Registros_Contador.Caption = ""   'zera os resultados encontrados
        Label_PlanBase.Caption = ""
        'limpa os campos do formulário
        TextBox1.Text = ""
        TextBox2.Text = ""
        TextBox3.Text = ""
        TextBox4.Text = ""
        TextBox5.Text = ""
        TextBox6.Text = ""
        TextBox7.Text = ""
        TextBox8.Text = ""
        TextBox9.Text = ""
        TextBox10.Text = ""

        MsgBox "Nenhum resultado para '" & TermoPesquisado & "' foi encontrado."
    
    End If
    
End Sub

Private Sub UserForm_Initialize()

    SpinButton1.Enabled = False
    btn_Editar.Enabled = False
    btn_Excluir.Enabled = False
    Combo_OndeSalvar.Visible = False
    Label_OndeSalvar.Visible = False
    Label_Registros_Contador.Caption = ""
    Call ConfigurarListaDeCampos
    
End Sub

Sub ConfigurarListaDeCampos()
Dim arrPesquisarNasPlanilhas As Variant
Dim i As Integer
    
    With ComboBox1
        .Style = fmStyleDropDownList
        
        .AddItem "Tudo"     '<--- Esta é utilizada para definir quando pesquisar em toda a planilha
        .AddItem "N° Processo"
        .AddItem "Data Aprovação"
        .AddItem "Responsável"
        .AddItem "Status"

        
        .ListIndex = 0
    End With
    
    With Combo_OndeSalvar
        'Recupera as Planilhas que são base de dados
        arrPesquisarNasPlanilhas = ConfigPlanilhasBase
    
        .Style = fmStyleDropDownList
        
        For i = 0 To UBound(arrPesquisarNasPlanilhas)
            .AddItem arrPesquisarNasPlanilhas(i)
        Next i
        
        .ListIndex = 0
    End With
    
    

End Sub

Function ConfigColunas(ByVal sNomeCampo As String) As String

    Select Case sNomeCampo
        Case "N° Processo"
            ConfigColunas = "A"
        Case "Data Aprovação"
            ConfigColunas = "D"
        Case "Responsável"
            ConfigColunas = "E"
        Case "Status"
            ConfigColunas = "F"
        Case Else           '<--- Esta é utilizada para definir quando pesquisar em toda a planilha
            ConfigColunas = ""
    End Select
    
End Function

Function ConfigPlanilhasBase() As Variant
Dim sNomeDasPlanilhas As String

    'Digite o nome das Planilhasonde os dados deverão ser procurados,
    'separados por ponto-e-vírgula (;)
    '
    sNomeDasPlanilhas = "PG;IN;RQ"   '<----- Informe as planilhas aqui
    
    
    Do While (Right(sNomeDasPlanilhas, 1) = ";")
        sNomeDasPlanilhas = Left(sNomeDasPlanilhas, Len(sNomeDasPlanilhas) - 1)
    Loop
    
    ConfigPlanilhasBase = Split(sNomeDasPlanilhas, ";")
    
End Function

Sub HabilitarControlesParaEdicao(ByVal bOpcao As Boolean)
    
    'Habilitar Botões Salvar/Cancelar
    btn_Salvar.Visible = bOpcao
    btn_Cancelar.Visible = bOpcao
    'btn_Adicionar.Visible = Not (bOpcao)
    btn_Editar.Visible = Not (bOpcao)
    btn_Excluir.Visible = Not (bOpcao)
    
    btn_Procurar.Enabled = Not (bOpcao)
    txt_Procurar.Enabled = Not (bOpcao)
    ComboBox1.Enabled = Not (bOpcao)
    txt_Procurar.Value = ""
    Label_Registros_Contador.Caption = ""
    Label_PlanBase.Caption = ""
    
    If bOpcao = False And IsArray(MatrizResultadosLinha) Then
        SpinButton1.Enabled = True
    Else
        SpinButton1.Enabled = False
    End If
    
    'Liberar Campos para Edição.
    TextBox1.Locked = Not (bOpcao)
    TextBox2.Locked = Not (bOpcao)
    TextBox3.Locked = Not (bOpcao)
    TextBox4.Locked = Not (bOpcao)
    TextBox5.Locked = Not (bOpcao)
    TextBox6.Locked = Not (bOpcao)
    TextBox7.Locked = Not (bOpcao)
    TextBox8.Locked = Not (bOpcao)
    TextBox9.Locked = Not (bOpcao)
    TextBox10.Locked = Not (bOpcao)

    
    'Limpar o conteúdo dos campos
    If sAcaoRequerida <> "Editar" Then
        TextBox1.Value = ""
        TextBox2.Value = ""
        TextBox3.Value = ""
        TextBox4.Value = ""
        TextBox5.Value = ""
        TextBox6.Value = ""
        TextBox7.Value = ""
        TextBox8.Value = ""
        TextBox9.Value = ""
        TextBox10.Value = ""

        
        Combo_OndeSalvar.Visible = bOpcao
        Label_OndeSalvar.Visible = bOpcao
    End If
    
    If bOpcao = True Then
        TextBox1.SetFocus
    End If
    

End Sub


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
joseA
Jedi
Jedi
Mensagens: 1048
Registrado em: Qui Out 22, 2009 7:22 am
Localização: Cel. Fabriciano - MG

Re: Auto executar e filtro por aba

Mensagem por joseA »

Olá Diego,

Sem ver nada, assim no chute fica dificil. Para executar a macro ao acionar a planilha, seria:

Código: Selecionar todos

Private Sub Worksheet_Activate()
Call Macro1
End Sub


Diego_moreira
Colaborador
Colaborador
Mensagens: 23
Registrado em: Seg Mai 21, 2012 10:15 am

Re: Auto executar e filtro por aba

Mensagem por Diego_moreira »

Estou mandando em anexo a planilha para que possam avaliar.
Anexos
Lista Mestra de documentos.zip
PLanilha para avaliação
(77.33 KiB) Baixado 287 vezes


Diego_moreira
Colaborador
Colaborador
Mensagens: 23
Registrado em: Seg Mai 21, 2012 10:15 am

Re: Auto executar e filtro por aba

Mensagem por Diego_moreira »

joseA escreveu:Olá Diego,

Sem ver nada, assim no chute fica dificil. Para executar a macro ao acionar a planilha, seria:

Código: Selecionar todos

Private Sub Worksheet_Activate()
Call Macro1
End Sub
Onde está macro1 eu substituo pelo nome do formulário?

Ex:

Código: Selecionar todos

Private Sub Worksheet_Activate()
Call UserForm
End Sub


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
joseA
Jedi
Jedi
Mensagens: 1048
Registrado em: Qui Out 22, 2009 7:22 am
Localização: Cel. Fabriciano - MG

Re: Auto executar e filtro por aba

Mensagem por joseA »

Diego_moreira escreveu:1° - Preciso adicionar um filtro no campo de pesquisa, para que eu possa selecionar a aba onde a pesquisa deve se restringir..
Em

Código: Selecionar todos

Private Sub UserForm_Initialize()
apague essa linha:

Código: Selecionar todos

Combo_OndeSalvar.Visible = False
Diego_moreira escreveu:2° - Preciso que a macro se auto execute quando a planilha for aberta.
No ambiente VBA de cada planilha coloque:

Código: Selecionar todos

Private Sub Worksheet_Activate()
UserForm.Show
End Sub


Diego_moreira
Colaborador
Colaborador
Mensagens: 23
Registrado em: Seg Mai 21, 2012 10:15 am

Re: Auto executar e filtro por aba

Mensagem por Diego_moreira »

joseA escreveu: Em

Código: Selecionar todos
Private Sub UserForm_Initialize()

apague essa linha:

Código: Selecionar todos
Combo_OndeSalvar.Visible = False
joseA, eu havia desabilitado o Combo_onde salvar porque não estava conseguindo fazer com que a pesquisa se restringisse a planilha selecionada. OU seja, eu preciso que a pesquisa seja efetuada somente na planilha selecionada no combo_ondesalvar.

Diego_moreira escreveu:No ambiente VBA de cada planilha coloque:

Código: Selecionar todos
Private Sub Worksheet_Activate()
UserForm.Show
End Sub
Funcionou perfeitamente, porém acho que não me expressei corretamente.
Deixa eu ver se consigo me expressar melhor. Eu preciso que depois que eu execute o arquivo, ou seja, a planilha estava fechada, dei duplo click para executa-la, e quando ela abrir, preciso que a macro execute automaticamente.

Valeu pela atenção!


Avatar do usuário
joseA
Jedi
Jedi
Mensagens: 1048
Registrado em: Qui Out 22, 2009 7:22 am
Localização: Cel. Fabriciano - MG

Re: Auto executar e filtro por aba

Mensagem por joseA »

Vc quer habilitar a macro do arquivo automático, ao abrir. É isso?

Vc pode alterar as configurações de segurança, embora seja questionável. Quem deixou de habilitar macros para um arquivo de origem, totalmente desconhecido? :lol:


Diego_moreira
Colaborador
Colaborador
Mensagens: 23
Registrado em: Seg Mai 21, 2012 10:15 am

Re: Auto executar e filtro por aba

Mensagem por Diego_moreira »

joseA escreveu:Vc quer habilitar a macro do arquivo automático, ao abrir. É isso?
Exatamente, mais eu já consegui fazer isso.

Só está faltando colocar o filtro. Tem como me ajudar nessa parte?


Avatar do usuário
Melo
Colaborador
Colaborador
Mensagens: 70
Registrado em: Ter Jan 12, 2010 4:26 pm

Re: Auto executar e filtro por aba

Mensagem por Melo »

Irmão,

O titio Melo não entendeu nada do seu questionamento.

O material posta esta funcionando, só adicionei na Pasta de Trabalho o UserForm para abrir ao executar a planilha.

Esta fazendo as pesquisas e carregando nas TextBox corretamente.

O Campo 'Onde procurar" esta funcionando, seleciona por qual forma deseja pesquisar.


Irmão você poderia esclarecer + para que possa ajuda-ló


Diego_moreira
Colaborador
Colaborador
Mensagens: 23
Registrado em: Seg Mai 21, 2012 10:15 am

Re: Auto executar e filtro por aba

Mensagem por Diego_moreira »

Melo escreveu:Irmão,

O titio Melo não entendeu nada do seu questionamento.

O material posta esta funcionando, só adicionei na Pasta de Trabalho o UserForm para abrir ao executar a planilha.

Esta fazendo as pesquisas e carregando nas TextBox corretamente.

O Campo 'Onde procurar" esta funcionando, seleciona por qual forma deseja pesquisar.


Irmão você poderia esclarecer + para que possa ajuda-ló
Claro que posso esclarecer melhor titio Melo. :D

O campo "onde procurar" esta limitando a pesquisa por coluna. Ex.: Se eu selecinar no campo "onde procurar" a opção 'n° de registro', a pesquisa será feita na coluna A de todas as planilhas.
Até ai tudo bem, está funcionando perfeitamento.
Mais eu gostaria de adicinar un novo filtro para a pesquisa. colocando um novo ComboBox, onde eu pudesse escolher em que planilha (PG,IN,RQ,...) a pesquisa seja efetuada. Ex.: Eu gostaria de fazer uma pesquisa que se restringisse a todos os 'n° de registros' da planilha "PG".
E ai, conseguiu entender? :P


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder