Dim informationer As Object: Set informationer = WordBasic.CurValues.UserDialog
start: x = WordBasic.Dialog.UserDialog(informationer, 1) On Error GoTo -1: On Error GoTo slut If x = 0 Then GoTo slut
'Checker dataene fra dialogboksen If WordBasic.Val(informationer.mdnr$) < 1 Then errtext$ = "Månedsnummer skal være større end 0" GoTo fejl End If If WordBasic.Val(informationer.mdnr$) > 12 Then errtext$ = "Månedsnummer skal være mindre end eller lig 12" GoTo fejl End If If WordBasic.Val(informationer.aar$) < 1900 Then errtext$ = "Makroen kan ikke håndtere årstal før 1900" GoTo fejl End If If WordBasic.Val(informationer.aar$) > 4000 Then errtext$ = "Makroen kan ikke håndtere årstal større end 4000" GoTo fejl End If If WordBasic.Val(informationer.antal$) < 1 Then errtext$ = "Antallet af måneder skal være større end 0" GoTo fejl End If If WordBasic.Val(informationer.antal$) > 12 Then errtext$ = "Makroen kan maksimalt håndtere 12 måneder" GoTo fejl End If
----------------------- følgende macro laver en kalender Jeg mangler at få tilføjet ugenr skal stå hver mandag i blank felt til højre - skæve helligedage mangler - en overskrift ?
Brug af AI afslører de svagheder, virksomheder allerede har opbygget gennem års cloud-transformation, nye SaaS-løsninger og fragmenterede sikkerhedssystemer.
De skæve helligdage er straks lidt mere kompliceret, da påskedag (som alle andre skæve helligdage beregnes ud fra) bliver lagt i forhold til en månekalender, hvorfor den kan ligge temmeligt forskelligt fra år til år.
Denne obskure funktion (jeg har ikke selv lavet den, så spørg mig ikke hvordan den virker!) returnerer den dato hvor påskedag ligger når den får et årstal som parameter:
Public Function Paaskedag(Yr As Integer) As Date
Dim d As Integer d = (((255 - 11 * (Yr Mod 19)) - 21) Mod 30) + 21 Paaskedag = DateSerial(Yr, 3, 1) + d + (d > 48) + 6 - ((Yr + Yr \ 4 + _ d + (d > 48) + 1) Mod 7)
End Function
Du vil altså hurtigt kunne finde den rigtige tekst, f.eks. gennem et kald til en funktion som:
Public Function HDtekst(Dato As Date) As String Dim Tekst As String Select Case Dato - Paaskedag(Year(Dato)) Case 50 Tekst = "2. Pinsedag" Case 49 Tekst = "Pinsedag" Case 39 Tekst = "Kristi himmelfartsdag" Case 26 Tekst = "St. Bededag" Case 1 Tekst = "2. Påskedag" Case 0 Tekst = "Påskedag" Case -2 Tekst = "Langfredag" Case -3 Tekst = "Skærtorsdag" Case -7 Tekst = "Palmesøndag" Case Else Tekst = "" End Select HDtekst = Tekst End Function
nedestående kode løser alt det jeg manglede - men jeg mangler stadig at få ugenr til at stå til højre i mandag's feltet på en måde uanset hvor stor feltet står det altid til højre også selvom jeg skriver i feltet ?
Function WEEKNR(InputDate As Long) As Integer Dim a As Integer, b As Integer, c As Long, d As Integer WEEKNR = 0 If InputDate < 1 Then Exit Function a = Weekday(InputDate, vbSunday) b = Year(InputDate + ((8 - a) Mod 7) - 3) c = DateSerial(b, 1, 1) d = (Weekday(c, vbSunday) + 1) Mod 7 WEEKNR = Int((InputDate - c - 3 + d) / 7) + 1 End Function
Function glrPåskedag(intYear As Integer) As Variant ' Udregner påskedag for et givet årstal ' Beregningsmetode ifl. Gauss Dim a As Integer Dim b As Integer Dim c As Integer Dim d As Integer Dim e As Integer Dim k As Integer Dim p As Integer Dim q As Integer Dim M As Integer Dim n As Integer Dim intDay As Integer Dim intMonth As Integer
k = intYear \ 100 p = (13 + 8 * k) \ 25 q = k \ 4 M = (15 - p + k - q) Mod 30 n = (4 + k - q) Mod 7 'Debug.Print k, p, q, m, n a = intYear Mod 19 b = intYear Mod 4 c = intYear Mod 7 d = (19 * a + M) Mod 30 e = (2 * b + 4 * c + 6 * d + n) Mod 7
If d + e <= 9 Then intDay = 22 + d + e intMonth = 3 ElseIf (d = 29) And (e = 6) Then intDay = 19 intMonth = 4 ElseIf (d = 28) And (e = 6) And (a > 10) Then intDay = 18 intMonth = 4 Else intDay = d + e - 9 intMonth = 4 End If glrPåskedag = DateSerial(intYear, intMonth, intDay) End Function
Function Helligdag(intYear As Integer, Helligdagstype As Integer) As Variant
' Returnerer datoen for de forskydelige helligdage. ' Helligdagstypen angives med en af de prædefinerede konstanter
Select Case Helligdagstype Case SKÆRTORSDAG Helligdag = glrPåskedag(intYear) - 3 Case LANGFREDAG Helligdag = glrPåskedag(intYear) - 2 Case PÅSKEDAG Helligdag = glrPåskedag(intYear) Case PÅSKEDAG2 Helligdag = glrPåskedag(intYear) + 1 Case BEDEDAG Helligdag = glrPåskedag(intYear) + 26 Case KRISTIHIMMELFARTSDAG Helligdag = glrPåskedag(intYear) + 39 Case PINSEDAG Helligdag = glrPåskedag(intYear) + 49 Case PINSEDAG2 Helligdag = glrPåskedag(intYear) + 50 End Select End Function
Function IsHelligdag(dtmDate As Variant) As Integer ' Returnerer TRUE hvis dtmDate er en helligdag Dim intYear As Integer Dim dtmPåskedag As Variant
Select Case dtmDate - dtmPåskedag Case -3, -2, 0, 1, 26, 39, 49, 50 IsHelligdag = True Case Else If (Month(dtmDate) = 1) And (Day(dtmDate) = 1) Then IsHelligdag = True ' Nytårsdag ElseIf (Month(dtmDate) = 5) And (Day(dtmDate) = 1) Then IsHelligdag = True ' 1 Maj ElseIf (Month(dtmDate) = 6) And (Day(dtmDate) = 5) Then IsHelligdag = True ' Grundlovsdag ElseIf (Month(dtmDate) = 12) And (Day(dtmDate) = 25) Then IsHelligdag = True ' Juledag ElseIf (Month(dtmDate) = 12) And (Day(dtmDate) = 26) Then IsHelligdag = True ' 2. juledag End If End Select End Function
Public Sub MAIN() Dim x Dim errtext$ Dim maaned Dim aar Dim teller Dim dag Dim datosn
Dim informationer As Object: Set informationer = WordBasic.CurValues.UserDialog
start: x = WordBasic.Dialog.UserDialog(informationer, 1) On Error GoTo -1: On Error GoTo slut If x = 0 Then GoTo slut
'Checker dataene fra dialogboksen If WordBasic.Val(informationer.mdnr$) < 1 Then errtext$ = "Månedsnummer skal være større end 0" GoTo fejl End If If WordBasic.Val(informationer.mdnr$) > 12 Then errtext$ = "Månedsnummer skal være mindre end eller lig 12" GoTo fejl End If If WordBasic.Val(informationer.aar$) < 1900 Then errtext$ = "Makroen kan ikke håndtere årstal før 1900" GoTo fejl End If If WordBasic.Val(informationer.aar$) > 4000 Then errtext$ = "Makroen kan ikke håndtere årstal større end 4000" GoTo fejl End If If WordBasic.Val(informationer.antal$) < 1 Then errtext$ = "Antallet af måneder skal være større end 0" GoTo fejl End If If WordBasic.Val(informationer.antal$) > 12 Then errtext$ = "Makroen kan maksimalt håndtere 12 måneder" GoTo fejl End If
If ((Month(dtmDate) = 5) And (Day(dtmDate) = 1)) Or ((Month(dtmDate) = 6) And (Day(dtmDate) = 5)) Then Selection.Font.Size = 8 Else WordBasic.ShadingPattern 4 End If
Case Helligdag(CInt(aar), SKÆRTORSDAG) Selection.TypeText Text:="Skærtorsdag" WordBasic.WordLeft 2
Case Helligdag(CInt(aar), LANGFREDAG) Selection.TypeText Text:="Langfredag" WordBasic.WordLeft 2
Case Helligdag(CInt(aar), PÅSKEDAG) Selection.TypeText Text:="Påskedag" WordBasic.WordLeft 2
Case Helligdag(CInt(aar), PÅSKEDAG2) Selection.TypeText Text:="2. Påskedag" WordBasic.WordLeft 4
Case Helligdag(CInt(aar), BEDEDAG) Selection.TypeText Text:="St.Bededag" WordBasic.WordLeft 4
Case Helligdag(CInt(aar), KRISTIHIMMELFARTSDAG) Selection.TypeText Text:="Kr.himmelfartsdag" WordBasic.WordLeft 4
Case Helligdag(CInt(aar), PINSEDAG) Selection.TypeText Text:="Pinsedag" WordBasic.WordLeft 2
Case Helligdag(CInt(aar), PINSEDAG2) Selection.TypeText Text:="2. Pinsedag" WordBasic.WordLeft 4
Case Else
If (Month(dtmDate) = 1) And (Day(dtmDate) = 1) Then Selection.TypeText Text:="Nytårsdag" ElseIf (Month(dtmDate) = 5) And (Day(dtmDate) = 1) Then Selection.TypeText Text:="1. Maj" ElseIf (Month(dtmDate) = 6) And (Day(dtmDate) = 5) Then Selection.TypeText Text:="Grundlovsdag" ElseIf (Month(dtmDate) = 12) And (Day(dtmDate) = 25) Then Selection.TypeText Text:="Juledag" ElseIf (Month(dtmDate) = 12) And (Day(dtmDate) = 26) Then Selection.TypeText Text:="2. Juledag" End If WordBasic.WordLeft 4
End Select
End If
Select Case WordBasic.Weekday(datosn) Case SØNDAG WordBasic.ShadingPattern 4 WordBasic.CharRight 1 Selection.Font.Size = 8
WordBasic.ShadingPattern 4 WordBasic.WordLeft 1
Case MANDAG If Not IsHelligdag(DateSerial(aar, maaned, dag)) Then WordBasic.WordRight 1 Selection.ParagraphFormat.Alignment = wdAlignParagraphRight Selection.Font.Color = wdColorBlack WordBasic.Insert Str(WEEKNR(Str(datosn)))
WordBasic.WordLeft 4 End If
Case LØRDAG WordBasic.ShadingPattern 4
Case Else
End Select
WordBasic.LineDown 1 datosn = datosn + 1 dag = dag + 1 maaned = WordBasic.Month(datosn) Wend
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
