Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: antonio2005pe en Mayo 03, 2022, 01:26:41 am
-
Estimados, por favor si alguien sabria como detectar el Jueves y Viernes Santo de cada año?, porque las fechas varian cada año y a veces cambia tambien con los años bisiestos, no tengo ni como verificar dichas fechas, lo quiero para detectar los dias feriados que caen en esas fechas, algo como esto:
Private Function CompJuevesyViernesSanto (Fecha as string) as Boolean
If Fecha = "JuevesSanto?" or Fecha = "ViernesSanto?" Then
CompJuevesyViernesSanto = True
Else
CompJuevesyViernesSanto = False
End If
End Function
donde "?" es como comprobar dichas fechas ya que es variable cada año.
Saludos,
-
Interesante pregunta, por lo que leí esta es la lógica
La Pascua de Resurrección es el domingo inmediatamente posterior a la primera Luna llena tras el equinoccio de marzo y se debe calcular empleando para el cálculo la Luna llena astronómica. Puede ocurrir no antes del 22 de marzo y el 25 de abril como muy tarde.
Así que la pregunta es cómo obtener las fauces lunares, voy a leer un poco haber si puedo encontrar algo.
-
bueno ahi creo que anduvo, encontré una rutina sencilla para calcular la fase lunar y con un bucle recorro 22 de marzo hasta el 25 de abril y cuando encuentra la luna llena busca el siguiente jueves, testie un par de fecha y concedieron bien la función es GetJuevesSanto() luego el viernes es fácil ya que solo hay que sumar un día, y después arme tu función tal como la pediste.
Option Explicit
Private Sub Form_Load()
Debug.Print CompJuevesyViernesSanto("12/01/2022") 'no
Debug.Print CompJuevesyViernesSanto("28/3/2013") 'si 'jueves santo
Debug.Print CompJuevesyViernesSanto("18/4/2014") 'si 'viernes santo
Debug.Print CompJuevesyViernesSanto("14/4/2022") 'si 'jueves santo
End Sub
Private Function CompJuevesyViernesSanto(ByVal Fecha As Date) As Boolean
Dim FechaJuevesSanto As Date
Dim FechaViernesSanto As Date
FechaJuevesSanto = GetJuevesSanto(year(Fecha))
FechaViernesSanto = FechaJuevesSanto + 1
If Fecha = FechaJuevesSanto Or Fecha = FechaViernesSanto Then
CompJuevesyViernesSanto = True
Else
CompJuevesyViernesSanto = False
End If
End Function
Private Function GetJuevesSanto(Año As Integer) As Date
Dim i As Long
Dim xDate As Date
Dim bFindFoolMoon As Boolean
xDate = "22/03/" & Año
For i = 1 To 34
If GetMoonPhase(year(xDate), month(xDate), day(xDate)) = 4 Then
bFindFoolMoon = True
End If
If bFindFoolMoon = True Then
If DatePart("w", xDate) = vbThursday Then
GetJuevesSanto = xDate
Exit Function
End If
End If
xDate = xDate + 1
Next
End Function
Function GetMoonPhase(year, month, day)
Dim c, e, jd, b
If (month < 3) Then
year = year - 1
month = month + 12
End If
month = month + 1
c = 365.25 * year
e = 30.6 * month
jd = c + e + day - 694039.09 '//jd is total days elapsed
jd = jd / 29.5305882 '//divide by the moon cycle
b = CInt(jd) '//int(jd) -> b, take integer part of jd
jd = jd - b '//subtract integer part to leave fractional part of original jd
b = Round(jd * 8) '//scale fraction from 0-8 and round
If (b >= 8) Then
b = 0 '//0 and 8 are the same so turn 8 into 0
End If
'// 0 => New Moon
'// 1 => Waxing Crescent Moon
'// 2 => Quarter Moon
'// 3 => Waxing Gibbous Moon
'// 4 => Full Moon
'// 5 => Waning Gibbous Moon
'// 6 => Last Quarter Moon
'// 7 => Waning Crescent Moon
GetMoonPhase = b
End Function
-
bueno ahi creo que anduvo, encontré una rutina sencilla para calcular la fase lunar y con un bucle recorro 22 de marzo hasta el 25 de abril y cuando encuentra la luna llena busca el siguiente jueves, testie un par de fecha y concedieron bien la función es GetJuevesSanto() luego el viernes es fácil ya que solo hay que sumar un día, y después arme tu función tal como la pediste.
Option Explicit
Private Sub Form_Load()
Debug.Print CompJuevesyViernesSanto("12/01/2022") 'no
Debug.Print CompJuevesyViernesSanto("28/3/2013") 'si 'jueves santo
Debug.Print CompJuevesyViernesSanto("18/4/2014") 'si 'viernes santo
Debug.Print CompJuevesyViernesSanto("14/4/2022") 'si 'jueves santo
End Sub
Private Function CompJuevesyViernesSanto(ByVal Fecha As Date) As Boolean
Dim FechaJuevesSanto As Date
Dim FechaViernesSanto As Date
FechaJuevesSanto = GetJuevesSanto(year(Fecha))
FechaViernesSanto = FechaJuevesSanto + 1
If Fecha = FechaJuevesSanto Or Fecha = FechaViernesSanto Then
CompJuevesyViernesSanto = True
Else
CompJuevesyViernesSanto = False
End If
End Function
Private Function GetJuevesSanto(Año As Integer) As Date
Dim i As Long
Dim xDate As Date
Dim bFindFoolMoon As Boolean
xDate = "22/03/" & Año
For i = 1 To 34
If GetMoonPhase(year(xDate), month(xDate), day(xDate)) = 4 Then
bFindFoolMoon = True
End If
If bFindFoolMoon = True Then
If DatePart("w", xDate) = vbThursday Then
GetJuevesSanto = xDate
Exit Function
End If
End If
xDate = xDate + 1
Next
End Function
Function GetMoonPhase(year, month, day)
Dim c, e, jd, b
If (month < 3) Then
year = year - 1
month = month + 12
End If
month = month + 1
c = 365.25 * year
e = 30.6 * month
jd = c + e + day - 694039.09 '//jd is total days elapsed
jd = jd / 29.5305882 '//divide by the moon cycle
b = CInt(jd) '//int(jd) -> b, take integer part of jd
jd = jd - b '//subtract integer part to leave fractional part of original jd
b = Round(jd * 8) '//scale fraction from 0-8 and round
If (b >= 8) Then
b = 0 '//0 and 8 are the same so turn 8 into 0
End If
'// 0 => New Moon
'// 1 => Waxing Crescent Moon
'// 2 => Quarter Moon
'// 3 => Waxing Gibbous Moon
'// 4 => Full Moon
'// 5 => Waning Gibbous Moon
'// 6 => Last Quarter Moon
'// 7 => Waning Crescent Moon
GetMoonPhase = b
End Function
La verdad es que no tenia ni la menor idea de como comprobar esas fechas, solo sabia que era entre Marzo y Abril y como eran variables y varian tambien por los años bisiestos.
Muchas Gracias,
Salu2