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


    [Resolvido]Filtros Sequenciais em subformulários

    avatar
    m_araujo
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 95
    Registrado : 15/11/2012

    [Resolvido]Filtros Sequenciais em subformulários Empty [Resolvido]Filtros Sequenciais em subformulários

    Mensagem  m_araujo 22/3/2016, 14:55

    Boa tarde!

    encontrei um exemplo na net sobre Filtros Sequenciais para subformulários gostei da ideia e resolvi aplicar em um pequeno projeto que estou a desenvolver, porem esta apresentando um erro que não consigo compreender gostaria muito da ajudar dos feras que temos aqui no forum.

    segue a rotina.


    '---------------------------------------------------------------------------------------
    ' 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!frm_busca_cep!lista_ceps

    '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!frm_busca_cep!lista_ceps.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("bt_removefiltro").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 tab_cep Where " & gstrFiltroAcumulado ' sempre que excuto a é apresentado um erro, ERRO EM TEMPO DE EXCULÇÃO 424; O OBJETO É OBRIGATÓRIO porem se eu TROCA o numero FORMULARIOS para FORMS aparece outra mensagem, ERRO EM TEMPO DE EXCULÇÃO 3075; ERRO DE SINTEXE NA EXPRESSÃO DE CONSULTA ' UF = 'AC esse é o critério no para busca"
    Formularios!frm_busca_cep!lista_ceps.Form.RecordSource = strSubSQL
    Formularios!frm_busca_cep!lista_ceps.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 tab_cep Where " & gstrFiltroAcumulado
    Formularios!frm_busca_cep!lista_ceps.Form.RecordSource = strSubSQL
    Formularios!frm_busca_cep!lista_ceps.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


    Uso Office 2013 64 Bits.

    Grato!

    Marcelo Ferreira
    avatar
    m_araujo
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 95
    Registrado : 15/11/2012

    [Resolvido]Filtros Sequenciais em subformulários Empty Re: [Resolvido]Filtros Sequenciais em subformulários

    Mensagem  m_araujo 19/4/2016, 14:29

    Resolvido

      Data/hora atual: 26/4/2024, 16:25