Palabras clave: fecha, laborable, dia.lab.intl
Autor: xavi
Necesidad
Obtener que día será una fecha dada una fecha inicial, un número de laborales, un tipo de semana laboral y la utilización de una tabla de festivos.
Es una emulación (con ligeros cambios) de la función DIA.LAB.INTL de Excel
Function DiaLabIntl(dtmFechaInicial As Date, intDiasProceso As Integer, Optional strTipoSemanaLaboral As String = "0000011", Optional blnAplicaFestivos As Boolean = True) As Date
' Función análoga a la de Excel utilizando el tipo de semana laboral como cadena y un boolean para aplicar laborables y festivos
' En caso de aplicar festivos será necesario indicar el nombre de la tabla y el campo de la tabla que contiene la fecha
' La cadena de strTipoSemanaLaboral se establece con 7 ceros y unos. El cero indica laborable y el uno festivo.
' Así, "0000011" indica el fin de semana de sábado-domingo. Esa técnica nos permite gestionar (casi) cualquier combinación
Const cTablaFestivos As String = "tblDatFestivos"
Const cCampoFecha As String = "FechaFestiva"
Dim dtmLaFecha As Date
Dim intdias As Integer
' Establecemos la fecha inicial
dtmLaFecha = dtmFechaInicial
' Bucle sin condiciones
Do
' Evaluamos si el día de la semana se ha estipulado como festivo.
If Mid(strTipoSemanaLaboral, Weekday(dtmLaFecha, vbMonday), 1) = "1" Then
' Es un NO-laborable: no hacemos nada
Else
' En este punto "parece" un laborable pero miramos si es festivo (si procede)
If blnAplicaFestivos And DCount("*", cTablaFestivos, cCampoFecha & "= " & CLng(dtmLaFecha)) > 0 Then
' es un festivo: nada
Else
' Ni es fin de semana, ni es festivo (sea porque no aplica, sea porque no lo es)
intdias = intdias + 1
End If
End If
' Comprobamos si hemos alcanzado el limite de días
If intdias >= intDiasProceso Then
DiaLabIntl = dtmLaFecha
Exit Function
End If
' Aumentamos un día
dtmLaFecha = DateAdd("d", 1, dtmLaFecha)
' Comprobación de seguridad
If dtmLaFecha > DateAdd("d", intDiasProceso + 1000, dtmFechaInicial) Then
MsgBox "Creo que nos hemos pasado de largo", vbExclamation
DiaLabIntl = "01/01/1900"
Exit Function
End If
Loop
End Function
