Boas Tardes!
Tenho o seguinte código numa rotina:
Private Sub Comando29_Click()
DoCmd.Hourglass True
'Autor Alexandre Neves e adaptado por Mendes
Me.Comando29.Visible = True
Me.Comando29.SetFocus
'************************************************
Dim DiaMes As Integer, MesTurno As Date
Dim Inicio As Date, Fim As Date
Dim Inicio2 As Date
Dim lbl As Label
Dim Rótulo As Label
Dim E As Object
Dim i As Long
Dim primerdia As Date
Dim ultimdia As Date
Dim calAny As Long
Dim callMes As Long
Dim Motivo As Long
Dim DiaSemana As Long
Dim DiaActual As Date
Dim wdia As Integer
Dim rst As DAO.Recordset
Dim DB As DAO.Database
Set DB = CurrentDb
Dim Rst1 As DAO.Recordset, Rst2 As DAO.Recordset, Rst5 As DAO.Recordset, Rst3 As DAO.Recordset ', Rst5 As DAO.Recordset
Dim AvancosPorFerias As Integer
Dim TurnoProximo As String ' Variável adicionada para manter o registro do próximo turno
If MsgBox("Confirmar a Rotina ? ", vbYesNo + vbQuestion, "Gestão") = vbYes Then
Inicio = Format(Me.Inicio, "mm-01-yyyy") ' Format(InputBox("Introduza a data inicial para a elaboração da escala."), "mm-01-yyyy")
Fim = Format(Me.Fim, "mm-01-yyyy") 'Format(InputBox("Introduza a data final para a elaboração da escala."), "mm-01-yyyy")
CurrentDb.Execute "DELETE * FROM HorarioInicial;"
Set Rst1 = CurrentDb.OpenRecordset("SELECT FuncionarioID, NomeTrat, Horas FROM Funcionarios;")
Set Rst2 = CurrentDb.OpenRecordset("SELECT Turno FROM Turnos;")
Set Rst3 = CurrentDb.OpenRecordset("SELECT Turno FROM Turnos1;")
Rst1.MoveLast: Rst1.MoveFirst
Rst2.MoveLast: Rst2.MoveFirst
Rst3.MoveLast: Rst3.MoveFirst
Do While Not Rst1.EOF
Rst2.MoveFirst
Rst2.Move Rst1.AbsolutePosition Mod Rst2.RecordCount
Rst3.MoveFirst
Rst3.Move Rst1.AbsolutePosition Mod Rst3.RecordCount
For MesTurno = Inicio To Fim
If Day(Format(MesTurno, "mm-dd-yyyy")) = 1 Then
For DiaMes = 1 To DateSerial(Year(Format(MesTurno, "mm-dd-yyyy")), Month(Format(MesTurno, "mm-dd-yyyy")) + 1, 1) - DateSerial(Year(Format(MesTurno, "mm-dd-yyyy")), Month(Format(MesTurno, "mm-dd-yyyy")), 1)
AvancosPorFerias = 0
If Rst2.EOF Then Rst2.MoveFirst
If Rst3.EOF Then Rst3.MoveFirst
If DiaMes = 1 Then
If DCount("*", "Ferias", "FuncionarioFID=" & Rst1(0) & " and(#" & Format(DateSerial(Year(MesTurno), Month(Format(MesTurno, "mm-dd-yyyy")), DiaMes), "mm-dd-yyyy") & "# Between Inicio2 and Fim2)") > 0 Then
CurrentDb.Execute "INSERT INTO HorarioInicial(FuncionarioID,NomeTrat,Horas,Mes,1) VALUES ('" & Rst1(0) & "','" & Rst1(1) & "','" & Rst1(2) & "',#" & MesTurno & "#,'L');"
Do While DCount("*", "Ferias", "FuncionarioFID=" & Rst1(0) & " and(#" & Format(DateSerial(Year(MesTurno), Month(Format(MesTurno, "mm-dd-yyyy")), DiaMes), "mm-dd-yyyy") & "# Between Inicio2 and Fim2)") > 0
Rst1.MoveNext: AvancosPorFerias = AvancosPorFerias + 1
Loop
Else
If Rst1!Horas1 = 8 Then
TurnoProximo = Rst2(0)
CurrentDb.Execute "INSERT INTO HorarioInicial(FuncionarioID,NomeTrat,Horas,Mes,1) VALUES ('" & Rst1(0) & "','" & Rst1(1) & "','" & Rst1(2) & " ',#" & MesTurno & "#,'" & TurnoProximo & "');"
If DCount("*", "Ferias", "FuncionarioFID=" & Rst1(0) & " and(#" & Format(DateSerial(Year(MesTurno), Month(Format(MesTurno, "mm-dd-yyyy")), DiaMes), "mm-dd-yyyy") & "# Between Inicio2 and Fim2)") = 0 Then
Rst2.MoveNext
End If
Else
TurnoProximo = Rst3(0)
CurrentDb.Execute "INSERT INTO HorarioInicial(FuncionarioID,NomeTrat,Horas,Mes,1) VALUES ('" & Rst1(0) & "','" & Rst1(1) & "','" & Rst1(2) & " ',#" & MesTurno & "#,'" & TurnoProximo & "');"
If DCount("*", "Ferias", "FuncionarioFID=" & Rst1(0) & " and(#" & Format(DateSerial(Year(MesTurno), Month(Format(MesTurno, "mm-dd-yyyy")), DiaMes), "mm-dd-yyyy") & "# Between Inicio2 and Fim2)") = 0 Then
Rst3.MoveNext
End If
End If
End If
Else
If DCount("*", "Ferias", "FuncionarioFID=" & Rst1(0) & " and(#" & Format(DateSerial(Year(MesTurno), Month(Format(MesTurno, "mm-dd-yyyy")), DiaMes), "mm-dd-yyyy") & "# Between Inicio2 and Fim2)") > 0 Then
CurrentDb.Execute "UPDATE HorarioInicial SET " & DiaMes & "='L' WHERE NomeTrat='" & Rst1(1) & "' and Mes=#" & MesTurno & "#;"
Do While DCount("*", "Ferias", "FuncionarioFID=" & Rst1(0) & " and(#" & Format(DateSerial(Year(MesTurno), Month(Format(MesTurno, "mm-dd-yyyy")), DiaMes), "mm-dd-yyyy") & "# Between Inicio2 and Fim2)") > 0
Rst1.MoveNext: AvancosPorFerias = AvancosPorFerias + 1
Loop
Else
If Rst1!Horas1 = 8 Then
TurnoProximo = Rst2(0)
CurrentDb.Execute "UPDATE HorarioInicial SET " & DiaMes & "='" & TurnoProximo & "' WHERE NomeTrat='" & Rst1(1) & "' and Mes=#" & MesTurno & "#;"
If DCount("*", "Ferias", "FuncionarioFID=" & Rst1(0) & " and(#" & Format(DateSerial(Year(MesTurno), Month(Format(MesTurno, "mm-dd-yyyy")), DiaMes), "mm-dd-yyyy") & "# Between Inicio2 and Fim2)") = 0 Then
Rst2.MoveNext
End If
Else
TurnoProximo = Rst3(0)
CurrentDb.Execute "UPDATE HorarioInicial SET " & DiaMes & "='" & TurnoProximo & "' WHERE NomeTrat='" & Rst1(1) & "' and Mes=#" & MesTurno & "#;"
If DCount("*", "Ferias", "FuncionarioFID=" & Rst1(0) & " and(#" & Format(DateSerial(Year(MesTurno), Month(Format(MesTurno, "mm-dd-yyyy")), DiaMes), "mm-dd-yyyy") & "# Between Inicio2 and Fim2)") = 0 Then
Rst3.MoveNext
End If
End If
Next
End If
Rst1.Move -AvancosPorFerias
Next
End If
Rst1.MoveNext
Loop
Set Rst1 = Nothing: Set Rst3 = Nothing: Set Rst4 = Nothing
MsgBox " Rotina Terminada ", vbExclamation, "Gestão"
Me.Requery
Call Form_Load
Else
DoCmd.CancelEvent
Exit Sub
End If
End Sub
Está a dar erro "next without for" aqui:
End If
End If
Next
End If
Rst1.Move -AvancosPorFerias
Alguém que me possa fazer o favor de me ajudar?
Tenho o seguinte código numa rotina:
Private Sub Comando29_Click()
DoCmd.Hourglass True
'Autor Alexandre Neves e adaptado por Mendes
Me.Comando29.Visible = True
Me.Comando29.SetFocus
'************************************************
Dim DiaMes As Integer, MesTurno As Date
Dim Inicio As Date, Fim As Date
Dim Inicio2 As Date
Dim lbl As Label
Dim Rótulo As Label
Dim E As Object
Dim i As Long
Dim primerdia As Date
Dim ultimdia As Date
Dim calAny As Long
Dim callMes As Long
Dim Motivo As Long
Dim DiaSemana As Long
Dim DiaActual As Date
Dim wdia As Integer
Dim rst As DAO.Recordset
Dim DB As DAO.Database
Set DB = CurrentDb
Dim Rst1 As DAO.Recordset, Rst2 As DAO.Recordset, Rst5 As DAO.Recordset, Rst3 As DAO.Recordset ', Rst5 As DAO.Recordset
Dim AvancosPorFerias As Integer
Dim TurnoProximo As String ' Variável adicionada para manter o registro do próximo turno
If MsgBox("Confirmar a Rotina ? ", vbYesNo + vbQuestion, "Gestão") = vbYes Then
Inicio = Format(Me.Inicio, "mm-01-yyyy") ' Format(InputBox("Introduza a data inicial para a elaboração da escala."), "mm-01-yyyy")
Fim = Format(Me.Fim, "mm-01-yyyy") 'Format(InputBox("Introduza a data final para a elaboração da escala."), "mm-01-yyyy")
CurrentDb.Execute "DELETE * FROM HorarioInicial;"
Set Rst1 = CurrentDb.OpenRecordset("SELECT FuncionarioID, NomeTrat, Horas FROM Funcionarios;")
Set Rst2 = CurrentDb.OpenRecordset("SELECT Turno FROM Turnos;")
Set Rst3 = CurrentDb.OpenRecordset("SELECT Turno FROM Turnos1;")
Rst1.MoveLast: Rst1.MoveFirst
Rst2.MoveLast: Rst2.MoveFirst
Rst3.MoveLast: Rst3.MoveFirst
Do While Not Rst1.EOF
Rst2.MoveFirst
Rst2.Move Rst1.AbsolutePosition Mod Rst2.RecordCount
Rst3.MoveFirst
Rst3.Move Rst1.AbsolutePosition Mod Rst3.RecordCount
For MesTurno = Inicio To Fim
If Day(Format(MesTurno, "mm-dd-yyyy")) = 1 Then
For DiaMes = 1 To DateSerial(Year(Format(MesTurno, "mm-dd-yyyy")), Month(Format(MesTurno, "mm-dd-yyyy")) + 1, 1) - DateSerial(Year(Format(MesTurno, "mm-dd-yyyy")), Month(Format(MesTurno, "mm-dd-yyyy")), 1)
AvancosPorFerias = 0
If Rst2.EOF Then Rst2.MoveFirst
If Rst3.EOF Then Rst3.MoveFirst
If DiaMes = 1 Then
If DCount("*", "Ferias", "FuncionarioFID=" & Rst1(0) & " and(#" & Format(DateSerial(Year(MesTurno), Month(Format(MesTurno, "mm-dd-yyyy")), DiaMes), "mm-dd-yyyy") & "# Between Inicio2 and Fim2)") > 0 Then
CurrentDb.Execute "INSERT INTO HorarioInicial(FuncionarioID,NomeTrat,Horas,Mes,1) VALUES ('" & Rst1(0) & "','" & Rst1(1) & "','" & Rst1(2) & "',#" & MesTurno & "#,'L');"
Do While DCount("*", "Ferias", "FuncionarioFID=" & Rst1(0) & " and(#" & Format(DateSerial(Year(MesTurno), Month(Format(MesTurno, "mm-dd-yyyy")), DiaMes), "mm-dd-yyyy") & "# Between Inicio2 and Fim2)") > 0
Rst1.MoveNext: AvancosPorFerias = AvancosPorFerias + 1
Loop
Else
If Rst1!Horas1 = 8 Then
TurnoProximo = Rst2(0)
CurrentDb.Execute "INSERT INTO HorarioInicial(FuncionarioID,NomeTrat,Horas,Mes,1) VALUES ('" & Rst1(0) & "','" & Rst1(1) & "','" & Rst1(2) & " ',#" & MesTurno & "#,'" & TurnoProximo & "');"
If DCount("*", "Ferias", "FuncionarioFID=" & Rst1(0) & " and(#" & Format(DateSerial(Year(MesTurno), Month(Format(MesTurno, "mm-dd-yyyy")), DiaMes), "mm-dd-yyyy") & "# Between Inicio2 and Fim2)") = 0 Then
Rst2.MoveNext
End If
Else
TurnoProximo = Rst3(0)
CurrentDb.Execute "INSERT INTO HorarioInicial(FuncionarioID,NomeTrat,Horas,Mes,1) VALUES ('" & Rst1(0) & "','" & Rst1(1) & "','" & Rst1(2) & " ',#" & MesTurno & "#,'" & TurnoProximo & "');"
If DCount("*", "Ferias", "FuncionarioFID=" & Rst1(0) & " and(#" & Format(DateSerial(Year(MesTurno), Month(Format(MesTurno, "mm-dd-yyyy")), DiaMes), "mm-dd-yyyy") & "# Between Inicio2 and Fim2)") = 0 Then
Rst3.MoveNext
End If
End If
End If
Else
If DCount("*", "Ferias", "FuncionarioFID=" & Rst1(0) & " and(#" & Format(DateSerial(Year(MesTurno), Month(Format(MesTurno, "mm-dd-yyyy")), DiaMes), "mm-dd-yyyy") & "# Between Inicio2 and Fim2)") > 0 Then
CurrentDb.Execute "UPDATE HorarioInicial SET " & DiaMes & "='L' WHERE NomeTrat='" & Rst1(1) & "' and Mes=#" & MesTurno & "#;"
Do While DCount("*", "Ferias", "FuncionarioFID=" & Rst1(0) & " and(#" & Format(DateSerial(Year(MesTurno), Month(Format(MesTurno, "mm-dd-yyyy")), DiaMes), "mm-dd-yyyy") & "# Between Inicio2 and Fim2)") > 0
Rst1.MoveNext: AvancosPorFerias = AvancosPorFerias + 1
Loop
Else
If Rst1!Horas1 = 8 Then
TurnoProximo = Rst2(0)
CurrentDb.Execute "UPDATE HorarioInicial SET " & DiaMes & "='" & TurnoProximo & "' WHERE NomeTrat='" & Rst1(1) & "' and Mes=#" & MesTurno & "#;"
If DCount("*", "Ferias", "FuncionarioFID=" & Rst1(0) & " and(#" & Format(DateSerial(Year(MesTurno), Month(Format(MesTurno, "mm-dd-yyyy")), DiaMes), "mm-dd-yyyy") & "# Between Inicio2 and Fim2)") = 0 Then
Rst2.MoveNext
End If
Else
TurnoProximo = Rst3(0)
CurrentDb.Execute "UPDATE HorarioInicial SET " & DiaMes & "='" & TurnoProximo & "' WHERE NomeTrat='" & Rst1(1) & "' and Mes=#" & MesTurno & "#;"
If DCount("*", "Ferias", "FuncionarioFID=" & Rst1(0) & " and(#" & Format(DateSerial(Year(MesTurno), Month(Format(MesTurno, "mm-dd-yyyy")), DiaMes), "mm-dd-yyyy") & "# Between Inicio2 and Fim2)") = 0 Then
Rst3.MoveNext
End If
End If
Next
End If
Rst1.Move -AvancosPorFerias
Next
End If
Rst1.MoveNext
Loop
Set Rst1 = Nothing: Set Rst3 = Nothing: Set Rst4 = Nothing
MsgBox " Rotina Terminada ", vbExclamation, "Gestão"
Me.Requery
Call Form_Load
Else
DoCmd.CancelEvent
Exit Sub
End If
End Sub
Está a dar erro "next without for" aqui:
End If
End If
Next
End If
Rst1.Move -AvancosPorFerias
Alguém que me possa fazer o favor de me ajudar?