Ojalá me pueda ayudar alguién a corregir el error de compilación en el siguiente código en la función EsFindeSemana:
Public Function AñadeDiasLab(lngDias As Long, Optional FechaIn As Date = 0, Optional ArrVacaciones As Variant) As Date
Dim lngConteo As Long
Dim dtmTemp As Date
If FechaIn = 0 Then FechaIn = Date
dtmTemp = FechaIn
For lngConteo = 1 To lngDias
dtmTemp = SigDiaLab(dtmTemp, ArrVacaciones)
Next lngConteo
AñadeDiasLab = dtmTemp
End Function
'--------------------------------------------------------------------------------------------------------------------------
Public Function SigDiaLab(Optional FechaIn As Date = 0, Optional ArrVacaciones As Variant = Empty) As Date
If FechaIn = 0 Then FechaIn = Date
SigDiaLab = SaltarVacaciones(ArrVacaciones, FechaIn + 1, 1)
End Function
'--------------------------------------------------------------------------------------------------------------------------
Public Function AntDiaLab(Optional FechaIn As Date = 0, Optional ArrVacaciones As Variant = Empty) As Date
If FechaIn = 0 Then FechaIn = Date
AntDiaLab = SaltarVacaciones(ArrVacaciones, FechaIn - 1, -1)
End Function
'--------------------------------------------------------------------------------------------------------------------------
Public Function PrimerDiaLabMes(Optional FechaIn As Date = 0, Optional ArrVacaciones As Variant = Empty) As Date
Dim dtmTemp As Date
If FechaIn = 0 Then FechaIn = Date
dtmTemp = DateSerial(Year(FechaIn), Month(FechaIn), 1)
PrimerDiaLabMes = SaltarVacaciones(ArrVacaciones, dtmTemp, 1)
End Function
'--------------------------------------------------------------------------------------------------------------------------
Public Function UltimoDiaLabMes(Optional FechaIn As Date = 0, Optional ArrVacaciones As Variant = Empty) As Date
Dim dtmTemp As Date
If FechaIn = 0 Then FechaIn = Date
dtmTemp = DateSerial(Year(FechaIn), Month(FechaIn) + 1, 0)
UltimoDiaLabMes = SaltarVacaciones(ArrVacaciones, dtmTemp, -1)
End Function
'--------------------------------------------------------------------------------------------------------------------------
Public Function ContarDiasLab(ByVal dtmInicio As Date, ByVal dtmFin As Date, Optional ArrVacaciones As Variant = Empty) As Integer
Dim intDias As Integer, dtmTemp As Date, intExtrae As Integer
If dtmFin < dtmInicio Then
dtmTemp = dtmInicio
dtmInicio = dtmFin
dtmFin = dtmTemp
End If
dtmInicio = SaltarVacaciones(ArrVacaciones, dtmInicio, 1)
dtmFin = SaltarVacaciones(ArrVacaciones, dtmFin, -1)
If dtmInicio > dtmFin Then
ContarDiasLab = 0
Else
intDias = dtmFin - dtmInicio + 1
intExtrae = (DateDiff("ww", dtmInicio, dtmFin) * 2)
intExtrae = intExtrae + _
ContarVacacionesA(ArrVacaciones, dtmInicio, dtmFin)
ContarDiasLab = intDias - intExtrae
End If
End Function
'--------------------------------------------------------------------------------------------------------------------------
Private Function ContarVacacionesA(ArrVacaciones As Variant, dtmInicio As Date, dtmFin As Date) As Long
Dim lngItem As Long
Dim lngConteo As Long
Dim blnEncontrado As Long
Dim dtmTemp As Date
On Error GoTo ManejoError
lngConteo = 0
Select Case VarType(ArrVacaciones)
Case vbArray + vbDate, vbArray + vbVariant
For lngItem = LBound(ArrVacaciones) To UBound(ArrVacaciones)
dtmTemp = ArrVacaciones(lngItem)
If dtmTemp >= dtmInicio And dtmTemp <= dtmFin Then
If Not EsFindeSemana(dtmTemp) Then
lngConteo = lngConteo + 1
End If
End If
Next lngItem
Case vbDate
If ArrVacaciones >= dtmInicio And ArrVacaciones <= dtmFin Then
If Not EsFindeSemana(ArrVacaciones) Then
lngConteo = 1
End If
End If
End Select
ExitHere:
ContarVacacionesA = lngConteo
Exit Function
ManejoError:
Resume ExitHere
End Function
Private Function FindItemInArray(varItemToFind As Variant, _
avarItemsToSearch As Variant) As Boolean
Dim lngItem As Long
On Error GoTo ManejoError
For lngItem = LBound(avarItemsToSearch) To UBound(avarItemsToSearch)
If avarItemsToSearch(lngItem) = varItemToFind Then
FindItemInArray = True
GoTo ExitHere
End If
Next lngItem
ExitHere:
Exit Function
ManejoError:
Resume ExitHere
End Function
'--------------------------------------------------------------------------------------------------------------------------
Private Function EsFindeSemana(dtmTemp As Variant) As Boolean
If VarType(dtmTemp) = vbDate Then
Select Case DiadeSemana(dtmTemp)
Case vbSaturday, vbSunday
EsFindeSemana = True
Case Else
EsFindeSemana = False
End Select
End If
End Function
'--------------------------------------------------------------------------------------------------------------------------
Private Function SaltarVacaciones(ArrVacaciones As Variant, dtmTemp As Date, intIncrement As Integer) As Date
Dim strCriterio As String
Dim strNomCampo As String
Dim lngItem As Long
Dim blnEncontrado As Boolean
On Error GoTo ManejoError
Do
Do While EsFindeSemana(dtmTemp)
dtmTemp = dtmTemp + intIncrement
Loop
Select Case VarType(ArrVacaciones)
Case vbArray + vbDate, vbArray + vbVariant
Do
blnEncontrado = FindItemInArray(dtmTemp, ArrVacaciones)
If blnEncontrado Then
dtmTemp = dtmTemp + intIncrement
End If
Loop Until Not blnEncontrado
Case vbDate
If dtmTemp = ArrVacaciones Then
dtmTemp = dtmTemp + intIncrement
End If
End Select
Loop Until Not EsFindeSemana(dtmTemp)
ExitHere:
SaltarVacaciones = dtmTemp
Exit Function
ManejoError:
Resume ExitHere
End Function