MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

2 participantes

    [Resolvido]Filtros multiplos ordem decrescente

    avatar
    ictsp
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 222
    Registrado : 02/09/2016

    [Resolvido]Filtros multiplos ordem decrescente Empty [Resolvido]Filtros multiplos ordem decrescente

    Mensagem  ictsp 2/3/2017, 14:18

    Bom dia amigos! Tenho um form com 4 combobox que filtram um subform conforme vão sendo selecionados os dados nas combos.
    Gostaria de saber se é possível filtrar e organizar o campo "data" do subform em ordem decrescente. O form principal é PRG e o subform é PRGSUB.  O código que estou usando é este disponibilizado por Paulo R. Robilotta (www.accessporexemplo.wordpress.com/)

    Código:
    Projeto : Filtros Sequenciais para subformulários
    ' Modulo  : FS
    ' Autor   : Paulo R. Robilotta (www.accessporexemplo.wordpress.com/)
    ' Data    : 14/6/10
    ' Função  : Constroi a RowSource das caixas de combinação em função das escolhas do usuário.
    '           Altera o RecordSource do subformulário de acordo com as escolhas das caixas de combinação
    '               de modo a selecionar os registros correspondentes.
    '
    'Arquitetura:
    '
    '   O formulário FS tem um subformulário chamado FSsub
    '   As caixas de combinação usadas nas filtragens tem o prefixo "fm" + o nome do campo do subformulário
    '       que elas filtram (Ex: Nome do campo = Nome -> Nome da caixa de combinação = fmNome)
    '
    'Variáveis globais:
    '   gstrRecordSourceOriginal : A ela é atribuída a string correspondente ao RecordSource original do
    '       subformulário e é definida no evento AoCarregar do formulário. É usada para restaurar o RecordSource
    '       do subformulário quando se clica no botão Remover Filtro.
    '   gstrTabela : Usada para armazenar o nome da tabela correspondente ao RecordSource do subformulário
    '   gstrFiltroAcumulado : Armazena cumulativamente as seleções das caixas de combinação. É usada na construção
    '       da SQL que determina o RecordSource do subformulário após cada seleção em uma caixa de combinação.
    '   gstrGroup : Armazena os nomes dos campos já selecionados pelas caixas de combinação. É usada na cláusula
    '       GROUP BY da SQL que determina o RowSouce das caixas de combinação.
    '   Essas variáveis são "zeradas" quando se fecha o formulário.
    '
    '
    'Observações sobre a adaptação ao seu programa:
    '1) Os nomes das variáveis foi dado de modo a torná-las bem explícitas, mas isso fez com que eles
    '   ficassem longos. Quando for fazer a adaptação ao seu programa, use nomes curtos para evitar problemas com
    '   o limite de caracteres possíveis da SQL.
    '2) Os locais onde você deve escrever manualmente o nome do subformulário está destacado com a
    '   palavra **** ATENÇÃO ****
    '---------------------------------------------------------------------------------------
    Option Compare Database
    Global gstrRecordSourceOriginal As String '
    Global gstrTabela As String
    Global gstrFiltroAcumulado As String ' Armazena os filtros já usados
    Global gstrGroup As String 'Armazena os nomes de campo que já foram usados na instrução GROUP BY

    Public Function FiltroSubformulario()


    Dim frmFormulario As Form
    Dim ctlSubformulario As Control
    Dim ctlsControlesDoFormulario As Control
    Dim strNomeDaCaixaDeCombinacaoSelecionada As String 'Nome da caixa de combinação selecionada
    Dim strNomeDoCampoCorrespondenteACaixaDeCombinacao As String 'Nome da caixa de combinação selecionada sem o prefixo -> Nome do campo
    Dim strValorDaCaixaDeCombinacaoSelecionada As String 'Valor da caixa de combinação selecionada
        
    '====== Coleta as variáveis referentes ao formulário =====

            'Nome da caixa de combinação selecionada
        strNomeDaCaixaDeCombinacaoSelecionada = Screen.ActiveControl.Name
                
            'Nome da caixa de combinação selecionada sem o prefixo -> Nome do campo
        strNomeDoCampoCorrespondenteACaixaDeCombinacao = Mid(strNomeDaCaixaDeCombinacaoSelecionada, 3, (Len(strNomeDaCaixaDeCombinacaoSelecionada) - 2))
                
            'Valor da caixa de combinação selecionada
        strValorDaCaixaDeCombinacaoSelecionada = Screen.ActiveControl.Value
                
            'Atribui à variável o formulário em uso
        Set frmFormulario = Screen.ActiveForm
          
        '***** ATENÇÃO *****
            'Atribui à variável ao subformulário
            'NA ADAPTAÇÃO, A LINHA ABAIXO DEVE SER ESCRITA COMO :
            'Set ctlSubformulario = Forms!NOMEDOFORMULARIO!NOMEDOSUBFORMULARIO
        Set ctlSubformulario = Forms!PRG!PRGSUB
            
            'Verifica se o RecordSource do formulário é uma instrução SQL
            'ou uma tabela/consulta
            
        Dim strRecordSourceDoSubformulario As String 'Variável para o RecordSource do Subformulário
        Dim strNomeDaTabela As String 'Variável para o nome da tabela
        
        '***** ATENÇÃO *****
            'Define a variável para o subformulário
            'NA ADAPTAÇÃO, A LINHA ABAIXO DEVE SER ESCRITA COMO :
            'strRecordSourceDoSubformulario = Forms!NOMEDOFORMULARIO!NOMEDOSUBFORMULARIO.Form.RecordSource
        strRecordSourceDoSubformulario = Forms!PRG!PRGSUB.Form.RecordSource
                
        
    '===== COLETA ORIGEM DO REGISTRO DO SUBFORMULÁRIO ======
        
            'Verifica se a variável possui a string "Select" (ou seja, se é uma
            'instrução SQL)
            'Se for instrução SQL, pega a parte da instrução referente ao nome da Tabela
        If InStr(1, strRecordSourceDoSubformulario, "Select") <> 0 Then
                'A condição - gstrFiltroAcumulado = "" - ocorre quando se clicou no botão Remover Filtro
                'ou na abertura do formulário.Ou seja, esta condição ocorre quando se faz a primeira
                'filtragem.
            If gstrFiltroAcumulado = "" Then
                strNomeDaTabela = Mid(strRecordSourceDoSubformulario, 9, (InStr(1, strRecordSourceDoSubformulario, ".") - 10))
                    'Atribui à variável global o nome da tabela
                gstrTabela = strNomeDaTabela
            
                'Caso a variável - gstrFiltroAcumulado - tenha algum conteúdo, significa que alguma
                'filtragem anterior já foi feita.
            Else
                    'Usa o nome da tabela obtido na primeira filtragem
                strNomeDaTabela = gstrTabela
                    
            End If
            
            
            'Caso contrário, pega o nome da tabela
        Else
            
            strNomeDaTabela = strRecordSourceDoSubformulario
                'Atribui à variável global o nome da tabela/consulta
            gstrTabela = strNomeDaTabela
        End If
            
            
            'Desabilita a caixa de combinação selecionada
        frmFormulario("btRemoveFiltro").SetFocus
        frmFormulario(strNomeDaCaixaDeCombinacaoSelecionada).Enabled = False
                
        
    '===== DEFINE VARIAVEL DO FILTRO ACUMULADO E APLICA RECORDSOURCE AO SUBFORMULÁRIO =====
        
        Dim strSubSQL As String 'SQL usada como RecordSouce do subformulário
            
            'Verifica se é a primeira filtragem usando para isso a condição da variável
            ' gstrFiltroAcumulado que é = "" quando se abre o formulário ou se remove o filtro
                
            'Primeira filtragem
        If gstrFiltroAcumulado = "" Then
                
                'Define a frase relativa a HAVING na sql para as caixas de combinação
            gstrFiltroAcumulado = strNomeDoCampoCorrespondenteACaixaDeCombinacao & " = '" & strValorDaCaixaDeCombinacaoSelecionada & "'"
            
                'Define a frase relativa ao GROUP BY na sql para as caixas de combinação
            gstrGroup = strNomeDoCampoCorrespondenteACaixaDeCombinacao
                        
                'Define e aplica a SQL que serve de RecordSource para o subformulário
            strSubSQL = "Select* From CONSPR Where " & gstrFiltroAcumulado
            Forms!PRG!PRGSUB.Form.RecordSource = strSubSQL
            Forms!PRG!PRGSUB.Requery
        
            'Não é a primeira filtragem
        Else
                'Define a frase relativa a HAVING na sql
            gstrFiltroAcumulado = gstrFiltroAcumulado & " AND " & strNomeDoCampoCorrespondenteACaixaDeCombinacao & " = '" & strValorDaCaixaDeCombinacaoSelecionada & "'"
                
                'Define a frase relativa ao GROUP BY na sql
            gstrGroup = gstrGroup & "," & strNomeDoCampoCorrespondenteACaixaDeCombinacao
                
                'Define e aplica a SQL que serve de RecordSource para o subformulário
            strSubSQL = "Select* From CONSPR Where " & gstrFiltroAcumulado
            Forms!PRG!PRGSUB.Form.RecordSource = strSubSQL
            Forms!PRG!PRGSUB.Requery
                            
        End If
                
                'Ciclo pelos controles
        For Each ctlsControlesDoFormulario In frmFormulario.Controls
                
                'Se for o mesmo que o controle selecionado.
            If ctlsControlesDoFormulario.Name = Screen.ActiveControl.Name Then
                  
                   'Mantém o filtro como está atualmente
                frmFormulario.Filter = gstrFiltroAcumulado
                                
                'Se o nome for diferente
            Else
                    
                    'Se for uma das outras caixas de combinação usadas como filtro (prefixo "fm")
                If Mid(ctlsControlesDoFormulario.Name, 1, 2) = "fm" Then
                        
                        'Se o filtro ainda não foi acionado (Enabled = True)
                            'Lembre : toda vez que você aciona um filtro a caixa de combinação
                            '         correspondente é desabilitada algumas linhas acima
                            
                        'Constroi a sql correspondente ao Rowsource da(s) caixa(s) de combinação
                        'ainda não usadas.
                    If frmFormulario(ctlsControlesDoFormulario.Name).Enabled = True Then
                            
                        rsSQL = ""
                        rsSQL = rsSQL & "SELECT " & Mid(ctlsControlesDoFormulario.Name, 3, (Len(ctlsControlesDoFormulario.Name) - 2))
                        rsSQL = rsSQL & " FROM " & strNomeDaTabela
                        rsSQL = rsSQL & " GROUP BY " & Mid(ctlsControlesDoFormulario.Name, 3, (Len(ctlsControlesDoFormulario.Name) - 2)) & "," & gstrGroup
                        
                        rsSQL = rsSQL & " HAVING " & gstrFiltroAcumulado
                                                    
                            'Atribui a RowSource ao controle
                        Dim varControl As String
                        varControl = ctlsControlesDoFormulario.Name
                        frmFormulario(varControl).RowSource = rsSQL
                                        
                    End If
                
                End If
            
            End If
        
        Next
        
    End Function


    Nas combos apenas chamo a função.
    Tentei dessa forma, mas fala que o objeto tem que estar na janela ativa.

    Private Sub fmProd_AfterUpdate()
    Call FiltroSubformulario
    Me.PRGSUB.Form.OrderByOn = True
    Me.PRGSUB.Form.OrderBy = "[Data] DESC"
    End Sub

    Desde já agradeço a atenção e ajuda dos nobres colegas!!
    Dilson
    Dilson
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1743
    Registrado : 11/11/2009

    [Resolvido]Filtros multiplos ordem decrescente Empty Re: [Resolvido]Filtros multiplos ordem decrescente

    Mensagem  Dilson 4/3/2017, 09:11

    No código tem esse trecho:
    strSubSQL = "Select* From CONSPR Where " & gstrFiltroAcumulado

    Veja que é nele que a query acontece.

    Pode haver uma chance de dar certo se acrescentar o critério depois do where e concatenar com a variável gstrFiltroAcumulado assim:

    strSubSQL = "Select* From CONSPR Where DataTal=#DATA# AND " & gstrFiltroAcumulado

    Para ir ajustando você pode ver a sintaxe sql que a variável carrega por MsgBox:

    MsgBox gstrFiltroAcumulado
    avatar
    ictsp
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 222
    Registrado : 02/09/2016

    [Resolvido]Filtros multiplos ordem decrescente Empty Re: [Resolvido]Filtros multiplos ordem decrescente

    Mensagem  ictsp 5/3/2017, 15:43

    Boa tarde Dilson! Desculpa a demora, estava testando o que vc sugeriu e realmente deu certo!! Desde já, agradeço sua ajuda e atenção, muito obrigado! Tenho aprendido muito com vcs.

    Abraço!!

      Data/hora atual: 28/11/2022, 02:06