07. december 2009 - 17:32
#3
Rem EVT. JUSTERING VEDR.:
Rem Grundlovsdag, Juleaftensdag & Nytårsaftensdag
Rem Disse tælles IKKE med som arbejdsdage p.t.
Rem =============================================
Dim hÅr As Integer, påskeDag As Date
Dim hDageFaste As Variant, hDageVar As Variant
Dim fraDag As Date, tilDag As Date
Dim antalArbejdsDage As Integer
Private Sub CommandButton1_Click() 'Beregn
Dim dag As Date
ActiveWorkbook.Sheets("Indstillinger").Range("B6:B17").Select
Selection.ClearContents
fraDag = Me.TextBox1
tilDag = Me.TextBox2
hÅr = 0
antalArbejdsDage = 0
For dag = fraDag To tilDag
Rem opsætning af helligdage for året
If hÅr = 0 Or hÅr <> Year(dag) Then
påskeDag = beregnPåske(Year(dag))
opsætningAfHelligDage påskeDag
hÅr = Year(dag)
End If
Rem undersøg om helligdag
If erDetHelligdag(dag) = False Then
Rem Hvis nej - test om lør/søn
If Weekday(dag, vbMonday) < 6 Then
Rem optæl pr. måned
With ActiveWorkbook.Sheets("Indstillinger")
.Cells(Month(dag) + 5, 2) = .Cells(Month(dag) + 5, 2) + 1
End With
antalArbejdsDage = antalArbejdsDage + 1
End If
End If
Next dag
Me.Label4 = antalArbejdsDage
ActiveWorkbook.Sheets("Indstillinger").Activate
End Sub
Public Function beregnPåske(aar)
Rem Beregning af Paaske - 1900 - 2099
Rem =================================
Dim d, E, Q
b1 = aar Mod 19
d = 225 - (11 * b1)
If d > 50 Then
While d > 50
d = d - 30
Wend
End If
If d > 48 Then
d = d - 1
End If
E = (aar + Int(aar / 4) + d + 1) Mod 7
Q = d + 7 - E
If Q < 32 Then
m = "03"
Else
m = "04"
Q = Q - 31
End If
beregnPåske = CStr(Q) + "-" + m + "-" + CStr(aar)
End Function
Public Sub opsætningAfHelligDage(påskeDag)
Rem Faste
Rem Nytårsdag/(Grundlovsdag)/(Juleaften)/Juledag/2. Juledag/(Nytårsaften)
hDageFaste = Array("01-01", "05-06", "24-12", "25-12", "26-12", "31-12")
Rem Grundlovsdag
If Me.CheckBox1 = True Then
hDageFaste(1) = ""
End If
Rem Juleaften
If Me.CheckBox2 = True Then
hDageFaste(2) = ""
End If
Rem Nytårsaften
If Me.CheckBox3 = True Then
hDageFaste(5) = ""
End If
Rem Skærtorsdag/Langfredag/Påskedag/2. Påskedag/St. Bededag/Kr. Himmelfart/Pinsedag/2. Pinsedag
hDageVar = Array("", "", "", "", "", "", "", "")
Rem Skærtorsdag
hDageVar(0) = Format(DateAdd("d", -3, påskeDag), "dd-mm")
Rem Langfredag
hDageVar(1) = Format(DateAdd("d", -2, påskeDag), "dd-mm")
Rem Påskedag
hDageVar(2) = Format(påskeDag, "dd-mm")
Rem 2. Påskedag
hDageVar(3) = Format(DateAdd("d", 1, påskeDag), "dd-mm")
Rem St. Bededag
hDageVar(4) = Format(DateAdd("ww", 4, hDageVar(1)), "dd-mm")
Rem Kr. Himmelfart
hDageVar(5) = Format(DateAdd("ww", 6, hDageVar(0)), "dd-mm")
Rem Pinsedag
hDageVar(6) = Format(DateAdd("ww", 7, påskeDag), "dd-mm")
Rem 2. Pinsedag
hDageVar(7) = Format(DateAdd("d", 1, hDageVar(6)), "dd-mm")
End Sub
Public Function erDetHelligdag(testDato)
Dim f, dato As String
dato = Format(testDato, "dd-mm")
Rem Faste helligdage
For f = 0 To 5
If hDageFaste(f) = CStr(dato) Then
erDetHelligdag = True
Exit Function
End If
Next f
Rem Variable
For f = 0 To 7
If hDageVar(f) = dato Then
erDetHelligdag = True
Exit Function
End If
Next f
erDetHelligdag = False
End Function
Private Sub CommandButton2_Click() 'Luk
gemIndstillinger
Unload UserForm1
End Sub
Private Sub UserForm_activate()
læsIndstillinger
End Sub
Private Sub læsIndstillinger()
Me.CheckBox1 = sætCheckbox(2, 3)
Me.CheckBox2 = sætCheckbox(3, 3)
Me.CheckBox3 = sætCheckbox(4, 3)
End Sub
Private Function sætCheckbox(ræk, kol)
With ActiveWorkbook.Sheets("Indstillinger")
If .Cells(ræk, kol) = "x" Then
sætCheckbox = True
Else
sætCheckbox = False
End If
End With
End Function
Private Sub gemIndstillinger()
sætIndstilling 2, 3, Me.CheckBox1.Value
sætIndstilling 3, 3, Me.CheckBox2.Value
sætIndstilling 4, 3, Me.CheckBox1.Value
End Sub
Private Sub sætIndstilling(ræk, kol, værdi)
With ActiveWorkbook.Sheets("Indstillinger")
If værdi = True Then
.Cells(ræk, kol) = "x"
Else
.Cells(ræk, kol) = ""
End If
End With
End Sub
