Boa tarde a todos!
Estou adaptando um formulário que baixei do fórum com filtros em cadeia, está funcionando perfeitamente mais acrescentei as seguintes caixas de texto:
DataInicio, HoraInicio, DataTermino, HoraTérmino
Queria que ao clicasse no botão Mostrar Clientes executasse os procedimentos abaixo:
Concatenasse a DataInicio com HoraInicio e armazenasse em DataHoraInicio;
Concatenasse a DataTermino com HoraTérmino e armazenasse em DataHoraTémino;
Criasse o critério Entre DataHoraInicio E DataHoraTémino e filtrasse do Campo Data_Hora do SubfrmPesquisaClientes
Código que estou utilizando:
Private Sub AdicionarAWhere(FieldValue As Variant, FieldName As String, MyCriteria As String, ArgCount As Integer)
' Cria critério para a cláusula WHERE.
If FieldValue <> "" Then
' Adiciona "and" se existir outro critério.
If ArgCount > 0 Then
MyCriteria = MyCriteria & " and "
End If
' Anexa o critério ao critério já existente.
' Coloca FieldValue e o asterisco entre aspas.
MyCriteria = (MyCriteria & FieldName & " Like " & Chr(39) & FieldValue & Chr(42) & Chr(39))
' Aumenta a contagem de argumentos.
ArgCount = ArgCount + 1
End If
End Sub
' BOTÃO MOSTRAR CLIENTES
Private Sub Mostrar_clientes_Click()
' Cria uma cláusula WHERE usando critérios de procura inseridos pelo usuário e
' define a propriedade OrigemDoRegistro do subformulário Pesquisa Clientes.
Dim mysql As String, MyCriteria As String, MyRecordSource As String
Dim ArgCount As Integer
Dim Tmp As Variant
Dim DataHoraInicio As String,DataHoraTermino As String
DataHoraInicio = Me.DataInicio & " " & Me.HoraInicio
DataHoraTermino = Me.DataTermino & " " & Me.HoraTermino
'Filtra com critério
Form_SubfrmPesquisaClientes.Filter = "[Data_hora] Between " & (DataHoraInicio) & " And " & (DataHoraTermino) & ""
Form_SubfrmPesquisaClientes.FilterOn = True
' Inicializa a contagem de argumentos.
ArgCount = 0
' Inicializa instrução SELECT.
mysql = "SELECT * FROM [qryPesquisaClientes] WHERE "
MyCriteria = ""
' Usa valores inseridos nas caixas de texto do cabeçalho do formulário para criar critérios para a cláusula WHERE.
AdicionarAWhere [Procurarcliente], "[NomeCliente]", MyCriteria, ArgCount
AdicionarAWhere [ProcurarEspécie], "[Espécie]", MyCriteria, ArgCount
AdicionarAWhere [ProcurarRaça], "[Raça]", MyCriteria, ArgCount
AdicionarAWhere [ProcurarSexo], "[Sexo]", MyCriteria, ArgCount
AdicionarAWhere [DataHoraInicio], "[Data_Hora]", MyCriteria, ArgCount
AdicionarAWhere [DataHoraTermino], "[Data_Hora]", MyCriteria, ArgCount
' Se não há critério especificado, retorna todos os registros.
If MyCriteria = "" Then
MyCriteria = "True"
End If
' Cria instrução SELECT.
MyRecordSource = mysql & MyCriteria
' Define a propriedade OrigemDoRegistro de Subformulário Encontrar Clientes.
Me![SubfrmPesquisaClientes].Form.RecordSource = MyRecordSource
' Se nenhum registro corresponder ao critério, exibe mensagem.
' Move o foco para o botão Limpar.
If Me![SubfrmPesquisaClientes].Form.RecordsetClone.RecordCount = 0 Then
MsgBox "Nenhum registro corresponde ao critério que você inseriu.", vbInformation, "Nenhum Registro Encontrado"
Me!Limpar.SetFocus
Else
' Ativa controle na seção detalhe.
Tmp = AtivarControles("Detail", True)
' Move o ponto de inserção para o Subformulário Encontrar Produtos.
Me![SubfrmPesquisaClientes].SetFocus
End If
End Sub
Se alguém puder me ajudar, desde já agradeço.
Estou disponibilizando o banco.
Estou adaptando um formulário que baixei do fórum com filtros em cadeia, está funcionando perfeitamente mais acrescentei as seguintes caixas de texto:
DataInicio, HoraInicio, DataTermino, HoraTérmino
Queria que ao clicasse no botão Mostrar Clientes executasse os procedimentos abaixo:
Concatenasse a DataInicio com HoraInicio e armazenasse em DataHoraInicio;
Concatenasse a DataTermino com HoraTérmino e armazenasse em DataHoraTémino;
Criasse o critério Entre DataHoraInicio E DataHoraTémino e filtrasse do Campo Data_Hora do SubfrmPesquisaClientes
Código que estou utilizando:
Private Sub AdicionarAWhere(FieldValue As Variant, FieldName As String, MyCriteria As String, ArgCount As Integer)
' Cria critério para a cláusula WHERE.
If FieldValue <> "" Then
' Adiciona "and" se existir outro critério.
If ArgCount > 0 Then
MyCriteria = MyCriteria & " and "
End If
' Anexa o critério ao critério já existente.
' Coloca FieldValue e o asterisco entre aspas.
MyCriteria = (MyCriteria & FieldName & " Like " & Chr(39) & FieldValue & Chr(42) & Chr(39))
' Aumenta a contagem de argumentos.
ArgCount = ArgCount + 1
End If
End Sub
' BOTÃO MOSTRAR CLIENTES
Private Sub Mostrar_clientes_Click()
' Cria uma cláusula WHERE usando critérios de procura inseridos pelo usuário e
' define a propriedade OrigemDoRegistro do subformulário Pesquisa Clientes.
Dim mysql As String, MyCriteria As String, MyRecordSource As String
Dim ArgCount As Integer
Dim Tmp As Variant
Dim DataHoraInicio As String,DataHoraTermino As String
DataHoraInicio = Me.DataInicio & " " & Me.HoraInicio
DataHoraTermino = Me.DataTermino & " " & Me.HoraTermino
'Filtra com critério
Form_SubfrmPesquisaClientes.Filter = "[Data_hora] Between " & (DataHoraInicio) & " And " & (DataHoraTermino) & ""
Form_SubfrmPesquisaClientes.FilterOn = True
' Inicializa a contagem de argumentos.
ArgCount = 0
' Inicializa instrução SELECT.
mysql = "SELECT * FROM [qryPesquisaClientes] WHERE "
MyCriteria = ""
' Usa valores inseridos nas caixas de texto do cabeçalho do formulário para criar critérios para a cláusula WHERE.
AdicionarAWhere [Procurarcliente], "[NomeCliente]", MyCriteria, ArgCount
AdicionarAWhere [ProcurarEspécie], "[Espécie]", MyCriteria, ArgCount
AdicionarAWhere [ProcurarRaça], "[Raça]", MyCriteria, ArgCount
AdicionarAWhere [ProcurarSexo], "[Sexo]", MyCriteria, ArgCount
AdicionarAWhere [DataHoraInicio], "[Data_Hora]", MyCriteria, ArgCount
AdicionarAWhere [DataHoraTermino], "[Data_Hora]", MyCriteria, ArgCount
' Se não há critério especificado, retorna todos os registros.
If MyCriteria = "" Then
MyCriteria = "True"
End If
' Cria instrução SELECT.
MyRecordSource = mysql & MyCriteria
' Define a propriedade OrigemDoRegistro de Subformulário Encontrar Clientes.
Me![SubfrmPesquisaClientes].Form.RecordSource = MyRecordSource
' Se nenhum registro corresponder ao critério, exibe mensagem.
' Move o foco para o botão Limpar.
If Me![SubfrmPesquisaClientes].Form.RecordsetClone.RecordCount = 0 Then
MsgBox "Nenhum registro corresponde ao critério que você inseriu.", vbInformation, "Nenhum Registro Encontrado"
Me!Limpar.SetFocus
Else
' Ativa controle na seção detalhe.
Tmp = AtivarControles("Detail", True)
' Move o ponto de inserção para o Subformulário Encontrar Produtos.
Me![SubfrmPesquisaClientes].SetFocus
End If
End Sub
Se alguém puder me ajudar, desde já agradeço.
Estou disponibilizando o banco.
- Anexos
- Pesquisa.zip
- Você não tem permissão para fazer download dos arquivos anexados.
- (216 Kb) Baixado 23 vez(es)