Makro og VBA - Helligdags Funktion

Helligdags Funktion - 1. Maj

Udskrevet fra: Dansk Regneark Forum
Kategori: Hjælp til regneark.
Forum navn: Makro og VBA
Forum beskrivelse: Hjælp til Makroer og VBA-programmering
Web-adresse: https://forum.excel-regneark.dk/forum_posts.asp?TID=3961
Udskrevet den: 23.Nov.2024 kl. 03:50

Emne: Helligdags Funktion - 1. Maj

Besked fra: Ib Hansen
Emne: Helligdags Funktion - 1. Maj
Posteringsdato: 17.Jul.2019 kl. 10:23

Hej Forum.

Jeg har en Helligdags Funktion i et modul.

Her vil jeg godt kunne definere, om 1. Maj skal vises som en helligdag eller ikke, afhængig af en værdi "Ja" / "Nej" i en celle.

1. Maj virker som en Case i koden nedenunder - Med blå.

Hvordan definerer jeg i "Ja" / "Nej" i koden - Med rød .

uploads/1125/Kalende-Vis_1_maj.xlsm" rel="nofollow - Testark her

Function Påskedag(InputYear As Integer) As Long ' Returnerer datoen for PåskedagDim 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 PD + 26: HelligdagsNavn = "Store Bededag"
        Case PD + 39: HelligdagsNavn = "Kr. Himmelfartsdag"
        Case PD + 49: HelligdagsNavn = "Pinsedag"
        Case PD + 50: HelligdagsNavn = "2. Pinsedag"
        
Rem        Case DateSerial(InputYear, 12, 24): HelligdagsNavn = "Julaftensdag"
        Case DateSerial(InputYear, 12, 25): HelligdagsNavn = "1. Juledag"
        Case DateSerial(InputYear, 12, 26): HelligdagsNavn = "2. Juledag"
Rem        Case DateSerial(InputYear, 12, 31): HelligdagsNavn = "Nytårsaftensdag"
        Case DateSerial(InputYear, 6, 5): HelligdagsNavn = "Grundlovsdag"
        
        
        
        Case DateSerial(InputYear, 5, 1): HelligdagsNavn = "1. Maj"
        
        If Sheets("Indstil").Range("D10") = "Ja" Then DateSerial(InputYear, 5, 1) = "1. Maj"
        If Sheets("Indstil").Range("D10") = "Nej" Then DateSerial(InputYear, 5, 1) = ""
        
        
        
        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

Hvis jeg ikke svarer med det samme, er det fordi, jeg kører udenby's nu Confused

På forhånd tak.

-------------
Excel 2010 Dk og 2019 Dk på samme computer.
Bruger dog stadig mest 2010..
Men sådan er der jo så majet :o)

Svar:

Besked fra: Ib Hansen
Posteringsdato: 23.Jul.2019 kl. 07:50

Hej Forum.

Oplæg

- Man har en dato-kolonne, hvor den første dato kan ændres efter behov - F.eks. hvis man kun vil vise 1 mdr. ad gangen i arket.

- I celle til højre for hver dato, (eller anden celle) vises det, om datoen er en Helligdag, med Helligdags-navnet.
- Nogle bruger 1. maj som en ½ Helligdag og andre ikke - Derfor skal 1. maj være valgfri.

Jeg løste problemet og løsningen består af to koder.

I dato Funktions-koden er det med blåt.

Option Explicit'=========================================================================================
'=========================================================================================
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, Optional sYesNo As String) 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

    If lngdate <= 0 Then
        lngdate = Date
    End If

    InputYear = Year(lngdate)
    PD = Påskedag(InputYear)

    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 PD + 26: HelligdagsNavn = "Store Bededag"
        Case PD + 39: HelligdagsNavn = "Kr. Himmelfartsdag"
        Case PD + 49: HelligdagsNavn = "Pinsedag"
        Case PD + 50: HelligdagsNavn = "2. Pinsedag"
        Case DateSerial(InputYear, 6, 5): HelligdagsNavn = "Grundlovsdag"
        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 DateSerial(InputYear, 5, 1): HelligdagsNavn = "1. Maj"
            If UCase(sYesNo) = "YES" Then
                  HelligdagsNavn = "1. Maj"
            Else: HelligdagsNavn = ""
            End If
        Case Else
    End Select

    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

Denne kode indsættes i alle celler i Helligdags-kolonnen, der skal vise Helligdags-navnet.

=HVIS(A4=$P$10;HelligdagsNavn(A4; 0; 0; $P$11);HelligdagsNavn(A4; 0; 0))

- A4 = Datoen i dato-kolonnen - I næste celle bliver A4 selvfølgelig til A5 osv. der ned ad.

- $P$10 = Cellen med en fast dato = 1. maj, som A4 sammenlignes med.
- $P$11 = Cellen, hvor "YES" eller "" indsættes, f.eks. vha. en CheckBox.

Mvh.

God sommerferie Wink

-------------
Excel 2010 Dk og 2019 Dk på samme computer.
Bruger dog stadig mest 2010..
Men sådan er der jo så majet :o)