Foros del Web » Programación para mayores de 30 ;) » Bases de Datos General »

Problemas de sintaxis VBA

Estas en el tema de Problemas de sintaxis VBA en el foro de Bases de Datos General en Foros del Web. 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 ...
  #1 (permalink)  
Antiguo 26/11/2012, 11:35
 
Fecha de Ingreso: noviembre-2012
Mensajes: 1
Antigüedad: 12 años
Puntos: 0
Pregunta Problemas de sintaxis VBA

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

Etiquetas: access, sintaxis, vbasic
Atención: Estás leyendo un tema que no tiene actividad desde hace más de 6 MESES, te recomendamos abrir un Nuevo tema en lugar de responder al actual.
Respuesta




La zona horaria es GMT -6. Ahora son las 12:48.