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
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