finde helligdage

Function Påskedag(InputYear As Integer) As Long ' Returnerer datoen for Påskedag
Dim d As Integer
    d = (((255 - 11 * (InputYear Mod 19)) - 21) Mod 30) + 21
    Påskedag = DateSerial(InputYear, 3, 1) + d + (d > 48) + 6 - _
        ((InputYear + InputYear \ 4 + d + (d > 48) + 1) Mod 7)
End Function

Function HelligdagsNavn(lngdate As Long, InclSaturdays As Boolean, _
    InclSundays As Boolean) As String
' Returnerer Sand hvis lngDate er en Dansk HelligdagsNavn/nationaldag
' (valgfri inkludering af lørdag/søndag)
' bruger funktionen Påskedag
Dim InputYear As Integer, PD As Long, OK As Boolean
    If lngdate <= 0 Then lngdate = Date
    InputYear = Year(lngdate)
    PD = Påskedag(InputYear)
      OK = True
    Select Case lngdate ' Tester nedenstående påstande mod datoen
        Case DateSerial(InputYear, 1, 1): HelligdagsNavn = "Nytårsdag"
        Case PD - 3: HelligdagsNavn = "Skærtorsdag"
        Case PD - 2: HelligdagsNavn = "Langfredag"
        Case PD: HelligdagsNavn = "Påskedag"
        Case PD + 1: HelligdagsNavn = "2. Påskedag"
        Case DateSerial(InputYear, 6, 5): HelligdagsNavn = "Grundlovsdag"
        Case PD + 26: HelligdagsNavn = "Store Bededag"
        Case PD + 39: HelligdagsNavn = "Kristi Himmelfartsdag"
        Case PD + 49: HelligdagsNavn = "Pinsedag"
        Case PD + 50: HelligdagsNavn = "2. Pinsedag"
        Case DateSerial(InputYear, 12, 24): HelligdagsNavn = "Julaftensdag"
        Case DateSerial(InputYear, 12, 25): HelligdagsNavn = "1. Juledag"
        Case DateSerial(InputYear, 12, 26): HelligdagsNavn = "2. Juledag"
        Case DateSerial(InputYear, 12, 31): HelligdagsNavn = "Nytårsaftensdag"
        Case Else
          End Select
            OK = False
            If InclSaturdays Then ' Tester lørdage, hvis de skal medtages
                If Weekday(lngdate, vbMonday) = 6 Then
                    HelligdagsNavn = HelligdagsNavn & " Lørdag"
                End If
            End If
            If InclSundays Then ' Tester søndage, hvis de skal medtages
                If Weekday(lngdate, vbMonday) = 7 Then
                HelligdagsNavn = HelligdagsNavn & " Søndag"
                End If
          End If
 
End Function