> Er der nogen der ved hvor man kan læse om beregning af ugenumre
Function FindUgeNr(Dato As Date) As Integer
FindUgeNr = Format(Dato, "ww", vbUseSystemDayOfWeek, vbUseSystem)
End Function
> skudår
Function Skudaar(Aar As Integer) As Boolean
'------------------------------------------
' modul dato
' Er det valgte år et skudår
'
' Rettet 10-08-97
'------------------------------------------
Dim DageIAar As Integer
DageIAar = DateDiff("d", "01-01-" & Aar, "31-12-" & Aar)
If DageIAar > 364 Then
Skudaar = True
Else
Skudaar = False
End If
End Function
> fridage(Kr. Himmelfart, påske osv.)???????
'--------------------------------------
Function BeregnPaaskedag(Aar As Integer) As Date
'--------------------------------------
' modDato
' Udregner påskedag for et givet årstal
' Beregningsmetode ifl. Gauss
' Rettet 19-03-2001
'--------------------------------------
'Skrevet af Stephen Biering-Sørensen, DTI Center for IT
'--------------------------------------
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 = Aar \ 100
p = (13 + 8 * k) \ 25
q = k \ 4
m = (15 - p + k - q) Mod 30
n = (4 + k - q) Mod 7
a = Aar Mod 19
b = Aar Mod 4
c = Aar 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
BeregnPaaskedag = DateSerial(Aar, intMonth, intDay)
End Function
'--------------------------------------
Function ErHelligdag(Dato As Date) As Boolean
'--------------------------------------
' modDato
' Returnerer TRUE hvis datoen er en helligdag
' Rettet 19-03-2001
'--------------------------------------
Dim Aar As Integer
Dim Paaskedag As Date
Dim Forskel As Integer
ErHelligdag = False
Aar = Year(Dato)
Paaskedag = BeregnPaaskedag(Aar)
Forskel = DateDiff("d", Paaskedag, Dato, vbUseSystemDayOfWeek, vbUseSystem)
Select Case Forskel
Case -3: ErHelligdag = True 'Skærtorsdag
Case -2: ErHelligdag = True 'Langfredag
Case 0: ErHelligdag = True 'Påskedag *Udgangspunkt
Case 1: ErHelligdag = True '2 Påskedag
Case 26: ErHelligdag = True 'Bededag
Case 39: ErHelligdag = True 'Kristi himmelfart
Case 49: ErHelligdag = True 'Pinsedag
Case 50: ErHelligdag = True '2 Pinsedag
Case Else
If Month(Dato) = 1 And Day(Dato) = 1 Then
ErHelligdag = True ' Nytårsdag
ElseIf Month(Dato) = 5 And Day(Dato) = 1 Then
ErHelligdag = True '1 maj
ElseIf Month(Dato) = 6 And Day(Dato) = 5 Then
ErHelligdag = True 'Grundlovsdag
ElseIf Month(Dato) = 12 And Day(Dato) = 25 Then
ErHelligdag = True ' Juledag
ElseIf Month(Dato) = 12 And Day(Dato) = 26 Then
ErHelligdag = True ' 2. juledag
End If
End Select
End Function
Værsgo. Det er lavet til VBA men bør fungere under VB
Et eksempel kan ses i "Kalender" på min hjemmeside
--
Med venlig hilsen
Tom F. Jensen
Fiks og færdig software
www.ffsoft.dk
tje@ffsoft.dk