CassioFabre 21/10/2016, 10:38
Bom dia,
Os campos Bloco, Material, Avulso, Qualidade, Defeito e Esp., se preenchidos, montam uma string que faz a consulta na tblCadastroChapa. O formulário principal da imagem é o formEstoqueCavalete e a folha de dados é o subCavalete (acoplado à tblCavalete). Abaixo o trecho do código que faz a consulta. Talvez assim fique mais facil de ver onde está o erro. Obrigado.
Public Function filtraRegistros()
Dim sitTitulos As Boolean
Dim selEmpresa As String
Dim dataInicial, dataFinal, dataHoje
Dim strConsulta As String
Dim strCampos As String
Call limpaPesquisaMaterial
Call limpaTemporario
cbxRelacaoChapas.Requery
If selTodasEmpresas = True Then
selEmpresa = False
Else
selEmpresa = getEmpresaAtual
End If
If Me.qdSitTitulos = 1 Then
filtro = "baixado = false"
setSitTitulo ("emAberto")
Else
filtro = "baixado = true"
setSitTitulo ("baixado")
End If
strConsulta = "ativo = true"
If Not IsNull(txtBloco) = True Then
strConsulta = strConsulta & " and numerobloco = " & txtBloco & ""
strCampos = "numerobloco, "
End If
If cbxQualidade <> "*" Then
strConsulta = strConsulta & " and codigoclassificacao = " & cbxQualidade.Column(1) & ""
strCampos = strCampos & "codigoclassificacao, "
End If
If cbxPackingList <> "*" Then
strConsulta = strConsulta & " and packinglist = '" & cbxPackingList.Column(0) & "'"
strCampos = strCampos & "packinglist, "
End If
If selAvulso = True Then
strConsulta = strConsulta & " and packinglist = ''"
End If
If Not IsNull(txtDefeito) = True Then
strConsulta = strConsulta & " and defeito like '*" & txtDefeito & "*'"
strCampos = strCampos & "defeito, "
End If
If Not IsNull(txtEspessura) = True Then
strConsulta = strConsulta & " and espessura = " & txtEspessura & ""
strCampos = strCampos & "espessura"
End If
'faz a pesquisa
Dim rsConsulta As Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT distinct '" & strCampos & "', cavalete, ativo FROM tblCadastroChapa WHERE " & strConsulta & " GROUP BY cavalete, '" & strCampos & "', ativo")
If rs.RecordCount > 0 Then
Do While Not rs.EOF
If Not rs!cavalete = "" Then
Set rsConsulta = db.OpenRecordset("select * from tblCavalete WHERE cavalete = " & rs!cavalete & "")
If rsConsulta.RecordCount > 0 Then
rsConsulta.Edit
rsConsulta("selconsulta") = True
rsConsulta.Update
End If
End If
rs.MoveNext
Loop
rs.Close
End If
filtro = filtro & " and selconsulta = true"
If Not IsNull(txtCavalete) = True Then
filtro = filtro & " and cavalete = " & txtCavalete & ""
End If
If cbxMaterial <> "*" Then
filtro = filtro & " and codigomaterialcavalete = " & cbxMaterial.Column(2) & ""
End If
Select Case qdReserva
Case 1
filtro = filtro & " and reservado = true"
Case 2
filtro = filtro & " and reservado = false"
End Select
If cbxClienteReserva <> "*" Then
filtro = filtro & " and codigoclientereserva = " & cbxClienteReserva.Column(2) & ""
End If
dataInicial = Format(txtDataInicial, "mm/dd/yyyy")
dataFinal = Format(txtDataFinal, "mm/dd/yyyy")
dataHoje = Format(getDataHoje, "mm/dd/yyyy")
Select Case Me.qdOptFiltro
Case 1 'lançamento
filtro = filtro & " and datalancamento Between #" & dataInicial & "# AND #" & dataFinal & "# and ativo = true"
subCavalete.Form.Filter = filtro
subCavalete.Form.FilterOn = True
subCavalete.Requery
Case 2 'baixa
filtro = filtro & " and baixadoem Between #" & dataInicial & "# AND #" & dataFinal & "# and ativo = true"
subCavalete.Form.Filter = filtro
subCavalete.Form.FilterOn = True
subCavalete.Requery
Case 3 'todos
filtro = filtro & " and ativo = true"
subCavalete.Form.Filter = filtro
subCavalete.Form.FilterOn = True
subCavalete.Requery
End Select
End Function