Intervalo de Datas - Inicial e Final

Option Compare Database
Option Explicit

Private Sub Report_Load()

Dim intCont, intCont2, intCont3, intNum, intDia, DataFim, intHTP, intContHTP As Integer
Dim strMes, strMes1, strAno As String
Dim db As DAO.Database
Dim rsFaltas, rs, rsFeriadosCEM, rsRecessoCEM As DAO.Recordset
Dim intCount, intCount2, intCount3, intCount4, intRemovida As Integer
Dim strReg As String
Dim strFerias1, strFerias2, strTipoFeriado, strRecesso As String
Dim strRec1, strRec2, strRec3, strRec4 As String

'strReg = Nz(Form_Funcionários.txtREG_FUNC.Value)
strReg = 1
Me.txtREG.Value = strReg

Set db = CurrentDb
Set rs = db.OpenRecordset("Select [CARGO], [2013], [2014], [NOME_FUNC] from tb_Func where [REG_FUNC] = " & strReg & "")

strAno = Format(Form_Funcionários.txtDataAtual, "yyyy")

Me.txtANO.Value = strAno
Me.txtANO1.Value = strAno - 1

Me.txtNOME.Value = rs("NOME_FUNC")
Me.txtCARGO.Value = rs("CARGO")
Me.txtUE.Value = DLookup("[Nome_Escola]", "tb_DadosEscola")
Me.txtLOCAL.Value = DLookup("[Nome_Escola]", "tb_DadosEscola")
'Me.imgLogo.Picture = DLookup("[Logo]", "tb_DadosEscola")

'strFerias1 = Nz(Forms.FichaCem.txtFerias1)
'strFerias2 = Nz(Forms.FichaCem.txtFerias2)
'strRec1 = Nz(Forms.FichaCem.txtRecesso1)
'strRec2 = Nz(Forms.FichaCem.txtRecesso2)
'strRec3 = Nz(Forms.FichaCem.txtRecesso3)
'strRec4 = Nz(Forms.FichaCem.txtRecesso4)
'
'If Not IsNull(Forms.FichaCem.txtFerias1) Then
'    Me.txtFerias1 = " Férias - " & strFerias1 & " à " & strFerias2 & ""
'Else
'    Me.txtFerias1 = ""
'End If
'If Not IsNull(Forms.FichaCem.txtRecesso1) Then
'    Me.txtFerias2.Value = " Recesso Escolar - " & strRec1 & " à " & strRec2 & ""
'Else
'    Me.txtFerias2.Value = ""
'End If
'If Not IsNull(Forms.FichaCem.txtRecesso3) Then
'    Me.txtFerias3.Value = " Recesso Escolar - " & strRec3 & " à " & strRec4 & ""
'Else
'    Me.txtFerias3.Value = ""
'End If
'
'Me.txtObs1.Value = Forms.FichaCem.txtObs1.Value
'Me.txtObs2.Value = Forms.FichaCem.txtObs2.Value
'Me.txtObs3.Value = Forms.FichaCem.txtObs3.Value
Dim Rst As DAO.Recordset, PrimeiroDia As Date, UltimoDia As Date, NrTxt As Byte, MotivoFalta As String
Set Rst = CurrentDb.OpenRecordset("SELECT Data_Falta, Motivo_Falta FROM tb_Faltas WHERE Left(Motivo_Falta,7)='Licença' and Nome='" & rs("NOME_FUNC") & "' ORDER BY Motivo_Falta, Data_Falta;")
'poderá ser revisto para considerar datas em falta que não sejam dias de trabalho (Sábado, Domingo, Feriado, etc)
NrTxt = 0
Do While Not Rst.EOF
   If Rst.AbsolutePosition = 0 Then
       PrimeiroDia = Rst("Data_Falta")
       UltimoDia = Rst("Data_Falta")
       MotivoFalta = Rst("Motivo_Falta")
   ElseIf Rst("Data_Falta") = DateAdd("d", 1, UltimoDia) And Rst("Motivo_Falta") = MotivoFalta Then
       UltimoDia = Rst("Data_Falta")
   Else
       NrTxt = NrTxt + 1
       If PrimeiroDia = UltimoDia Then
           Me("txtLic" & NrTxt) = MotivoFalta & ": " & PrimeiroDia
       Else
           Me("txtLic" & NrTxt) = MotivoFalta & ": de " & PrimeiroDia & " a " & UltimoDia
       End If
       PrimeiroDia = Rst("Data_Falta")
       UltimoDia = Rst("Data_Falta")
       MotivoFalta = Rst("Motivo_Falta")
   End If
   Rst.MoveNext
Loop
Set Rst = Nothing

For intNum = 1 To 12
   Select Case intNum
       Case 1
           strMes = "Jan"
           strMes1 = "janeiro"
           DataFim = "31"
       Case 2
           If strAno Mod 400 = 0 Or (strAno Mod 4 = 0 And strAno Mod 100 <> 0) Then
           strMes = "Fev"
           strMes1 = "fevereiro"
           DataFim = "29"
           Else
           strMes = "Fev"
           strMes1 = "fevereiro"
           DataFim = "28"
       End If
       Case 3
           strMes = "Mar"
           strMes1 = "março"
           DataFim = "31"
       Case 4
           strMes = "Abr"
           strMes1 = "Abril"
           DataFim = "30"
       Case 5
           strMes = "Mai"
           strMes1 = "maio"
           DataFim = "31"
       Case 6
           strMes = "Jun"
           strMes1 = "junho"
           DataFim = "30"
       Case 7
           strMes = "Jul"
           strMes1 = "julho"
           DataFim = "31"
       Case 8
           strMes = "Ago"
           strMes1 = "agosto"
           DataFim = "31"
       Case 9
           strMes = "Set"
           strMes1 = "setembro"
           DataFim = "30"
       Case 10
           strAno = strAno - 1
           strMes = "Out"
           strMes1 = "outubro"
           DataFim = "31"
       Case 11
           strMes = "Nov"
           strMes1 = "novembro"
           DataFim = "30"
       Case 12
           strMes = "Dez"
           strMes1 = "dezembro"
           DataFim = "31"
   End Select

For intCont = 1 To DataFim

Set rsFeriadosCEM = db.OpenRecordset("Select [Dia_Feriado], [Tipo_Feriado] from tb_FeriadosCEM where [Dia_Feriado] = " & intCont & _
" And [Mes_Feriado] = " & intNum & "")

If rsFeriadosCEM.RecordCount <> 0 Then strTipoFeriado = rsFeriadosCEM("Tipo_Feriado")

Set rsRecessoCEM = db.OpenRecordset("Select [Dia_Recesso] from tb_RecessoCEM where [Dia_Recesso] = " & intCont & _
" And [Mes_Recesso] = " & intNum & "")

If rsRecessoCEM.RecordCount <> 0 Then strRecesso = "RE"

'Set rsFaltas = db.OpenRecordset("Select * From tb_Faltas Where [REG]=" & _
strReg & " And [MES_FALTA]= '" & strMes1 & "' and [ANO] = " & strAno & "")
Set rsFaltas = db.OpenRecordset("Select * From tb_Faltas Where [REG]=1 And [MES_FALTA]= '" & strMes1 & "' and [ANO] = " & strAno & "")

   If rsFaltas.RecordCount <> 0 Then rsFaltas.MoveFirst
   rsFaltas.FindFirst "DIA_FALTA=" & intCont
   If rsFaltas.NoMatch Then
       intDia = Weekday(intCont & "/" & intNum & "/" & strAno)

       Select Case intDia
           Case 1
               Me("txt" & strMes & intCont).Value = "D"
               Me("txt" & strMes & intCont).ForeColor = 25600
               Me("txt" & strMes & intCont).BackColor = 12713921
               Me("txt" & strMes & intCont).FontBold = True
           Case 2, 3, 4, 5, 6
               Me("txt" & strMes & intCont).Value = "C"
               Me("txt" & strMes & intCont).ForeColor = 16711680
           Case 7
               Me("txt" & strMes & intCont).Value = "S"
               Me("txt" & strMes & intCont).ForeColor = 25600
               Me("txt" & strMes & intCont).BackColor = 12713921
               Me("txt" & strMes & intCont).FontBold = True
       End Select

'=====================================================================================
'Grava nas caixas de texto respectivas aos dias de faltas
'=====================================================================================
   
   Else
       Select Case rsFaltas("MOTIVO_FALTA")
           Case "ABONADA"
               Me("txt" & strMes & intCont).Value = "FA"
               Me("txt" & strMes & intCont).ForeColor = 14822282
               Me("txt" & strMes & intCont).FontBold = True
           Case "FÉRIAS"
               Me("txt" & strMes & intCont).Value = "F"
               Me("txt" & strMes & intCont).FontBold = True
           Case "LICENÇA MÉDICA"
               Me("txt" & strMes & intCont).Value = "LM"
           Case "LICENÇA GESTANTE"
               Me("txt" & strMes & intCont).Value = "LG"
           Case "LICENÇA GALA"
               Me("txt" & strMes & intCont).Value = "LC"
           Case "LICENÇA PRÉ_NATAL"
               Me("txt" & strMes & intCont).Value = "LPN"
           Case "LICENÇA PRÊMIO"
               Me("txt" & strMes & intCont).Value = "LP"
           Case "LICENÇA NOJO"
               Me("txt" & strMes & intCont).Value = "LN"
           Case "TRE"
               Me("txt" & strMes & intCont).Value = "TRE"
           Case "DOAÇÃO DE SANGUE"
               Me("txt" & strMes & intCont).Value = "DS"
           Case "FALTA INJUSTIFICADA"
               Me("txt" & strMes & intCont).Value = "FI"
           Case "FALTA JUSTIFICADA"
               Me("txt" & strMes & intCont).Value = "FJ"
           Case "ATESTADO MÉDICO"
               Me("txt" & strMes & intCont).Value = "FJ"
           Case "FALTA HTP"
               Me("txt" & strMes & intCont).Value = "C"
       End Select
               
       For intCont2 = 1 To 12
           Select Case Form_FichaCem("cmbLic" & intCont2).Value
               Case "Licença Médica"
               If IsNull(Form_FichaCem("txtLic" & intCont2 + 12)) Then
                   Me("txtLic" & intCont2).Value = "LM: " & Form_FichaCem("txtLic" & intCont2).Value
               Else
                   Me("txtLic" & intCont2).Value = "LM: " & Form_FichaCem("txtLic" & intCont2).Value & _
                   " à " & Form_FichaCem("txtLic" & intCont2 + 12).Value
               End If
               Case "Licença Gestante"
                   Me("txtLic" & intCont2).Value = "LG: " & Form_FichaCem("txtLic" & intCont2).Value & _
                   " à " & Form_FichaCem("txtLic" & intCont2 + 12).Value
               Case "Licença sem Vencimentos"
                   Me("txtLic" & intCont2).Value = "LV: " & Form_FichaCem("txtLic" & intCont2).Value & _
                   " à " & Form_FichaCem("txtLic" & intCont2 + 12).Value
               Case "Licença Gala"
                   Me("txtLic" & intCont2).Value = "LC: " & Form_FichaCem("txtLic" & intCont2).Value & _
                   " à " & Form_FichaCem("txtLic" & intCont2 + 12).Value
               Case "Licença Nojo"
                   Me("txtLic" & intCont2).Value = "LN: " & Form_FichaCem("txtLic" & intCont2).Value & _
                   " à " & Form_FichaCem("txtLic" & intCont2 + 12).Value
           End Select
       Next intCont2
             
   End If
       
   If Me("txt" & strMes & intCont).Value <> "S" And Me("txt" & strMes & intCont).Value <> "D" And _
   Me("txt" & strMes & intCont).Value <> "-" And Me("txt" & strMes & intCont).Value <> "" _
   And Me("txt" & strMes & intCont).Value <> "FN/D" And Me("txt" & strMes & intCont).Value <> "FE/D" And _
   Me("txt" & strMes & intCont).Value <> "FN/S" _
   And Me("txt" & strMes & intCont).Value <> "FM/S" And Me("txt" & strMes & intCont).Value <> "FE/S" Then
      intCount = intCount + 1
   End If
   
   If ((strMes <> "Out") Or (strMes <> "Nov") Or (strMes <> "Dez")) And Me("txt" & strMes & intCont).Value <> "-" Then
       If Me("txt" & strMes & intCont).Value <> "S" And Me("txt" & strMes & intCont).Value <> "D" _
       And Me("txt" & strMes & intCont).Value <> "FN/D" And Me("txt" & strMes & intCont).Value <> "FE/D" And _
       Me("txt" & strMes & intCont).Value <> "FN/S" And Me("txt" & strMes & intCont).Value <> "FM/S" And _
       Me("txt" & strMes & intCont).Value <> "FE/S" Then
          intRemovida = intRemovida + 1
       End If
   End If
   
   If Me("txt" & strMes & intCont).Value <> "FI" And Me("txt" & strMes & intCont).Value <> "-" Then
       intCount2 = intCount2 + 1
   End If
       Me("txtComp" & intNum).Value = intCount2
       
   If Me("txt" & strMes & intCont).Value = "FI" Then
       intCount3 = intCount3 + 1
   End If
       Me("txtAfast" & intNum).Value = intCount3
       
'=====================================================================================
'Grava nas caixas de texto respectivas aos dias de feriados, as siglas dos mesmos
'=====================================================================================

If rsFeriadosCEM.RecordCount <> 0 Then rsFeriadosCEM.MoveFirst
   rsFeriadosCEM.FindFirst "Dia_Feriado=" & intCont
If rsFeriadosCEM.NoMatch Then
   intDia = Weekday(intCont & "/" & intNum & "/" & strAno)
Else
   Me("txt" & strMes & intCont).ForeColor = vbRed
   If intDia = 1 Then
       Me("txt" & strMes & intCont).Value = strTipoFeriado & "/D"
       Me("txt" & strMes & intCont).BackColor = 12713921
       Me("txt" & strMes & intCont).FontSize = 8
   ElseIf intDia = 7 Then
       Me("txt" & strMes & intCont).Value = strTipoFeriado & "/S"
       Me("txt" & strMes & intCont).BackColor = 12713921
       Me("txt" & strMes & intCont).FontSize = 8
   Else
       Me("txt" & strMes & intCont).Value = strTipoFeriado
   End If
End If

'=====================================================================================
''Grava nas caixas de texto respectivas aos dias de Recesso Escolar
'=====================================================================================

If rsRecessoCEM.RecordCount <> 0 Then rsRecessoCEM.MoveFirst
   rsRecessoCEM.FindFirst "Dia_Recesso=" & intCont
If rsRecessoCEM.NoMatch Then
   intDia = Weekday(intCont & "/" & intNum & "/" & strAno)
Else
   Me("txt" & strMes & intCont).Value = strRecesso
   Me("txt" & strMes & intCont).ForeColor = 25600
   Me("txt" & strMes & intCont).BackColor = 65535
   Me("txt" & strMes & intCont).FontBold = True
End If
   
'======================================================================================
'Caso seja professor que trabalhou alguns dias, fazer as alterações no código abaixo:
'======================================================================================

If rs("2013") = "NÃO" Then
   Me.txtFerias2 = Empty
   Me.txtObs1.Value = "Início das atividades nesta U.E. no dia 01/01/2014."
       If (intNum = 10 Or intNum = 11 Or intNum = 12 Or intNum = 1) Then
           Me("txt" & strMes & intCont).Value = "-"
           Me("txt" & strMes & intCont).BackColor = 9145219
       End If
End If
       
If rs("2014") = "NÃO" Then
   Me.txtFerias2 = Empty
   Me.txtObs1.Value = "Professora removida para outra U.E. a partir de 01/01/2014."
       Select Case intNum
           Case 1, 2, 3, 4, 5, 6, 7, 8, 9
           Me("txt" & strMes & intCont).Value = "-"
           Me("txt" & strMes & intCont).ForeColor = vbBlack
           Me("txt" & strMes & intCont).BackColor = 9145219
       End Select
End If
       
       'Select Case intNum
           'Case 1, 2, 3, 4, 5, 6, 7, 8, 9
               'Me("txt" & strMes & intCont).Value = "-"
               'Me("txt" & strMes & intCont).BackColor = 9145219
       'End Select
       'If (intNum = 4 And intCont < 13) Then
           'Select Case intCont
               'Case 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11
                   'Me("txt" & strMes & intCont).Value = "-"
                   'Me("txt" & strMes & intCont).BackColor = 9145219
           'End Select
       'End If
'------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------
   
Next intCont

   If IsNull(Me("txtComp" & intNum).Value) Then
       Me("txtComp" & intNum).Value = 0
   End If
   
   If IsNull(Me("txtAfast" & intNum).Value) Then
       Me("txtAfast" & intNum).Value = 0
   End If
   
   intCont2 = intCount2
   intCont3 = intCount3
   
   intCount2 = 0
   intCount3 = 0

Next intNum

'======================================================================================
'Faltas HTP
'======================================================================================

For intHTP = 1 To 9
   If Not IsNull(Me("txtHTPHoraFalta" & intHTP)) Then
       intContHTP = intContHTP + 1
   End If
Next intHTP

Me.txtHTPTotalFaltas.Value = intContHTP

Me.txtHTPTotalHoras.Value = intCount

If rs("2014") = "NÃO" Then
   Me.txtHTPTotalHoras.Value = intRemovida
Else
   Me.txtCompTotal.Value = (Me.txtComp1) + (Me.txtComp2) + (Me.txtComp3) + (Me.txtComp4) + (Me.txtComp5) + _
   (Me.txtComp6) + (Me.txtComp7) + (Me.txtComp8) + (Me.txtComp9) + (Me.txtComp10) + (Me.txtComp11) + (Me.txtComp12)
   Me.txtAfastTotal.Value = (Me.txtAfast1) + (Me.txtAfast2) + (Me.txtAfast3) + (Me.txtAfast4) + (Me.txtAfast5) + _
   (Me.txtAfast6) + (Me.txtAfast7) + (Me.txtAfast8) + (Me.txtAfast9) + (Me.txtAfast11) + (Me.txtAfast12) + (Me.txtAfast10)
End If

If rs("CARGO") = "PPI" Then
   If Not IsNull(Me.txtHTPTotalFaltas.Value) Then
       Me.txtHTPComparecimento.Value = Me.txtHTPTotalHoras.Value - (Me.txtHTPTotalFaltas.Value * "1")
   Else
       Me.txtHTPComparecimento.Value = Me.txtHTPTotalHoras.Value
       Me.txtHTPTotalFaltas.Value = 0
   End If
   If Not IsNull(Me.txtHTPComparecimento.Value) Then Me.txtHTPComparecimento.Value = ConverteHoraTexto(Me.txtHTPComparecimento.Value)
   Me.txtHTPTotalHoras.Value = ConverteHoraTexto(Me.txtHTPTotalHoras.Value)
ElseIf rs("CARGO") = "Secretário de Escola" Then
   Me.txtHTPTotalFaltas.Value = ""
   Me.txtHTPComparecimento.Value = ""
   Me.txtHTPTotalHoras.Value = ""
Else
   If Not IsNull(Me.txtHTPTotalFaltas.Value) Then
       Me.txtHTPComparecimento.Value = Me.txtHTPTotalHoras.Value - (Me.txtHTPTotalFaltas.Value * "1")
   Else
       Me.txtHTPComparecimento.Value = Me.txtHTPTotalHoras.Value
       Me.txtHTPTotalFaltas.Value = 0
   End If
   If Not IsNull(Me.txtHTPComparecimento.Value) Then Me.txtHTPComparecimento.Value = ConverteHoraTexto(Me.txtHTPComparecimento.Value)
   Me.txtHTPTotalHoras.Value = ConverteHoraTexto(Me.txtHTPTotalHoras.Value)
End If


'By JPaulo © MaximoAccess
Dim RsFaltas1 As DAO.Recordset
Dim yColuna As Integer
Dim db1 As DAO.Database
Dim I As Integer

Set db1 = CurrentDb

'Preenche os campos relacionados as faltas do tipo FALTA HTP
 
Set RsFaltas1 = db1.OpenRecordset("Select [DATA_FALTA], [MOTIVO_FALTA] From tb_Faltas where REG= " & Me.txtREG & _
" And [MOTIVO_FALTA]= 'FALTA HTP' ORDER BY [DATA_FALTA]")
 
If RsFaltas1.RecordCount <> 0 Then
   RsFaltas1.MoveLast
   RsFaltas1.MoveFirst
       For yColuna = 1 To RsFaltas1.RecordCount
           For I = 1 To 9 'referente a 9 caixas de texto
               On Error Resume Next
               Me.Controls("txtHTPDataFalta" & I).Value = RsFaltas1("DATA_FALTA")
               If rs("CARGO") = "PPI" Then
                   Me.Controls("txtHTPHoraFalta" & I).Value = ConverteHoraTexto("1")
               Else
                   Me.Controls("txtHTPHoraFalta" & I).Value = ConverteHoraTexto("2,50")
               End If
   
               RsFaltas1.MoveNext
           Next I
       Next yColuna
           RsFaltas1.Close
   Set RsFaltas1 = Nothing
End If

'======================================================================================
'Faltas TRE
'======================================================================================

'Preenche os campos relacionados as faltas do tipo TRE
Set RsFaltas1 = db1.OpenRecordset("Select [DATA_FALTA], [MOTIVO_FALTA] From tb_Faltas where REG= " & Me.txtREG & _
" And [MOTIVO_FALTA]= 'TRE' ORDER BY [DATA_FALTA]")
 
If RsFaltas1.RecordCount <> 0 Then
   RsFaltas1.MoveLast
   RsFaltas1.MoveFirst
       For yColuna = 1 To RsFaltas1.RecordCount
           For I = 1 To 15 'referente a 15 caixas de texto
               On Error Resume Next
               Me.Controls("txtOutros" & I).Value = "TRE - " & RsFaltas1("DATA_FALTA")
               RsFaltas1.MoveNext
           Next
       Next
           RsFaltas1.Close
   Set RsFaltas1 = Nothing
End If
       
'======================================================================================
'Faltas Abonadas
'======================================================================================

Set RsFaltas1 = db1.OpenRecordset("Select [DATA_FALTA], [MOTIVO_FALTA] From tb_Faltas where REG= " & Me.txtREG & _
" And [MOTIVO_FALTA]= 'ABONADA' ORDER BY [DATA_FALTA]")
 
If RsFaltas1.RecordCount <> 0 Then
   RsFaltas1.MoveLast
   RsFaltas1.MoveFirst
       For yColuna = 1 To RsFaltas1.RecordCount
           For I = 1 To 9 'referente a 9 caixas de texto
               On Error Resume Next
               Me.Controls("txtAbon" & I).Value = RsFaltas1("DATA_FALTA")
               RsFaltas1.MoveNext
           Next I
       Next yColuna
           RsFaltas1.Close
   Set RsFaltas1 = Nothing
End If

'======================================================================================
'Atestados Médicos
'======================================================================================

Set RsFaltas1 = db1.OpenRecordset("Select [DATA_FALTA], [MOTIVO_FALTA] From tb_Faltas where REG= " & Me.txtREG & _
" And [MOTIVO_FALTA]= 'ATESTADO MÉDICO' ORDER BY [DATA_FALTA]")
 
If RsFaltas1.RecordCount <> 0 Then
   RsFaltas1.MoveLast
   RsFaltas1.MoveFirst
       For yColuna = 1 To RsFaltas1.RecordCount
           For I = 1 To 9 'referente a 9 caixas de texto
               On Error Resume Next
               Me.Controls("txtOutros" & I).Value = "Atestado Médico - " & RsFaltas1("DATA_FALTA")
               RsFaltas1.MoveNext
           Next I
       Next yColuna
           RsFaltas1.Close
   Set RsFaltas1 = Nothing
End If

End Sub