Alexandre Neves 25/10/2011, 08:40
Bom dia,
Coloque
Private Sub btnMes_Click()
Dim StrSQL As String, StrSQL1 As String
If IsNull(DataInicial) = True Or Me.DataInicial = "" Or IsNull(DataFinal) = True Or Me.DataFinal = "" Then
MsgBox "é obrigatório o preenchimento dos campos Data Inicial e Data Final" & vbCrLf & "para efetuar a consulta", vbCritical, "Atençao!"
Exit Sub
Else
If Me.btnMes.Caption = "Filtrar" Then
If Format(Me.DataInicial, "dd/mm/yyyy") > Format(Me.DataFinal, "dd/mm/yyyy") Then
MsgBox "A Data Inicial não pode ser menor que a Data Final", vbCritical, "Atenção!"
Exit Sub
Else
Me.btnMes.Caption = "Filtrado"
Me.btnMes.ForeColor = vbRed
StrSQL = "SELECT tabCondenasp.ID_CodCondenas, tabCondenasp.CpData AS DATA," _
& "tabgranjas.CpNomeGranja AS GRANJA, tabCondenasp.CpTipo AS TIPO," _
& "tabCondenasp.CpAbcesso AS ABCESSO, tabCondenasp.CpAerosacolite AS AEROSACULITE," _
& "tabCondenasp.CpArtrite AS ARTRITE, tabCondenasp.CpAscite AS ASCITE," _
& "tabCondenasp.CpCaquexia AS CAQUEXIA," _
& "tabCondenasp.CpCelulite AS CELULITE," _
& "tabCondenasp.CpColigranulatose AS COLIGRANULATOSE, tabCondenasp.CpContaminacao AS CONTAMINAÇÃO," _
& "tabCondenasp.CpContusaoFratura AS [CONTUSÃO/FRATURA], tabCondenasp.CpDermatose AS DERMATOSE," _
& "tabCondenasp.CpEscaldagemExcessiva AS [ESCALDAGEM EXCESSIVA]," _
& "tabCondenasp.CpMaSangria AS [MA SANGRIA]," _
& "tabCondenasp.CpSalpingite AS SALPINGITE," _
& "tabCondenasp.Cpdoeca1 AS [DOENCA 1]," _
& "tabCondenasp.Cpdoeca2 AS [DOENCA 2]," _
& " FROM tabgranjas LEFT JOIN tabCondenasp ON tabgranjas.ID_Granja = tabCondenasp.ID_Granja" _
& " WHERE (((tabCondenasp.ID_CodCondenas) Is Not Null)) And ((tabCondenasp.CpData >=#" & Format(Me.DataInicial, "mm/dd/yyyy") & "#) And (tabCondenasp.CpData <=#" & Format(Me.DataFinal, "mm/dd/yyyy") & "#))"
If Me.CboGranja <> "" Then
StrSQL = StrSQL & " And tabCondenasp.ID_Granja =" & Me.txtGranja & ""
End If
If Me.CboTipoAve <> "" Then
StrSQL = StrSQL & " And tabCondenasp.CpTipo ='" & Me.CboTipoAve & "'"
End If
StrSQL = StrSQL & " ORDER BY tabCondenasp.CpData;"
Me.lstConsulta.RowSource = StrSQL
Call AplicarCalculos
End If
Else
Call LimpaFiltro
Me.txtAviso.Visible = False
Me.btnMes.Caption = "Filtrar"
Me.btnMes.ForeColor = vbBlack
End If
End If
If Me.txtQtdReg = -1 Then
MsgBox "Não foi encontrado registro para esta consulta!", vbInformation, "Atenção"
Me.txtAviso.Visible = True
End If
End Sub