Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
556to560
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
556to560
556to560
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

VBA Code

VBA Code
27.01.2005 18:58:04
Heinz
Was mache ich nur falsch
Hab einen VBA Code bekommen und möchte ihn ausprobieren, wenn ich aber auf "Ausführen und "Kompilieren" gehe kommt die Meldung "Fehler beim Kompilieren Syntaxfehler"
Attribute VB_Name = "modHolidays"
Option Explicit
' *** Den Artikel zu diesem Modul finden Sie unter http://www.aboutvb.de/khw/artikel/khwholidays.htm ***
Public Enum HolidayConstants
KeineFeiertage = 0
Neujahr = 1
HlDreiKoenige = 2
Rosenmontag = 4
Karfreitag = 8
OsterSo = 16
OsterMo = 32
ErsterMai = 64
Himmelfahrt = 128
PfingstSo = 256
PfingstMo = 512
Fronleichnam = 1024
Bundesfeier = 2048
AugsburgFrieden = 4096
MariaHimmel = 8192
DeutscheEinheit = 16384
Nationalfeier = 32768
Reformationstag = 65536
Allerheiligen = 131072
BussUndBet = 262144
MariaEmpf = 524288
Weihnacht1 = 1048576
Weihnacht2 = 2097152
End Enum
Public Const HdErrInvalidHoliday = 5
Public Const HdErrInvalidYear = 6
Public

Function EasterSunday(ByVal TestYear As Integer) As Date
Dim nN As Long
Dim nM As Long
Dim nA As Long
Dim nB As Long
Dim nC As Long
Dim nD As Long
Dim nE As Long
Dim nDate As Date
Select Case TestYear
Case 1582 To 1699
nM = 22
nN = 2
Case 1700 To 1799
nM = 23
nN = 3
Case 1800 To 1899
nM = 23
nN = 4
Case 1900 To 2099
nM = 24
nN = 5
Case 2100 To 2199
nM = 24
nN = 6
Case 2200 To 2299
nM = 25
nN = 0
Case 2300 To 2399
nM = 26
nN = 1
Case 2400 To 2499
nM = 25
nN = 1
Case Else
Err.Raise HdErrInvalidYear
End Select
nA = TestYear Mod 19
nB = TestYear Mod 4
nC = TestYear Mod 7
nD = ((19 * nA) + nM) Mod 30
nE = ((2 * nB) + (4 * nC) + (6 * nD) + nN) Mod 7
If (22 + nD + nE) > 31 Then
nDate = DateSerial(TestYear, 4, (nD + nE - 9))
Else
nDate = DateSerial(TestYear, 3, (22 + nD + nE))
End If
If Day(nDate) = 26 And Month(nDate) = 4 Then
nDate = DateSerial(TestYear, 4, 19)
End If
If Day(nDate) = 25 And Month(nDate) = 4 Then
If (nD = 28 And nA > 10) Then
nDate = DateSerial(TestYear, 4, 18)
End If
End If
EasterSunday = nDate
End Function

Public

Function Holiday(ByVal TestYear As Integer, ByVal Holidays As HolidayConstants) As Date
Dim nEasterDate As Date
Dim nDaysNovember As Integer
Select Case TestYear
Case 1582 To 2499
Case Else
Err.Raise HdErrInvalidYear
End Select
nEasterDate = EasterSunday(TestYear)
Select Case Holidays
Case Neujahr
Holiday = DateSerial(TestYear, 1, 1)
Case HlDreiKoenige
Holiday = DateSerial(TestYear, 1, 6)
Case Rosenmontag
Holiday = DateAdd("d", -48, nEasterDate)
Case Karfreitag
Holiday = DateAdd("d", -2, nEasterDate)
Case OsterSo
Holiday = nEasterDate
Case OsterMo
Holiday = DateAdd("d", 1, nEasterDate)
Case ErsterMai
Holiday = DateSerial(TestYear, 5, 1)
Case Himmelfahrt
Holiday = DateAdd("d", 39, nEasterDate)
Case PfingstSo
Holiday = DateAdd("d", 49, nEasterDate)
Case PfingstMo
Holiday = DateAdd("d", 50, nEasterDate)
Case Fronleichnam
Holiday = DateAdd("d", 60, nEasterDate)
Case Bundesfeier
Holiday = DateSerial(TestYear, 8, 1)
Case AugsburgFrieden
Holiday = DateSerial(TestYear, 8, 8)
Case MariaHimmel
Holiday = DateSerial(TestYear, 8, 15)
Case DeutscheEinheit
Select Case TestYear
Case 1954 To 1989
Holiday = DateSerial(TestYear, 6, 17)
Case Is > 1989
Holiday = DateSerial(TestYear, 10, 3)
Case Else
Err.Raise HdErrInvalidYear
End Select
Case Nationalfeier
Holiday = DateSerial(TestYear, 10, 26)
Case Reformationstag
Holiday = DateSerial(TestYear, 12, 31)
Case Allerheiligen
Holiday = DateSerial(TestYear, 11, 1)
Case BussUndBet
For nDaysNovember = 1 To 7
nEasterDate = DateSerial(TestYear, 11, nDaysNovember)
If Weekday(nEasterDate) = 4 Then
Holiday = DateAdd("d", 14, nEasterDate)
Exit Function
End If
Next nDaysNovember
Case MariaEmpf
Holiday = DateSerial(TestYear, 12, 6)
Case Weihnacht1
Holiday = DateSerial(TestYear, 12, 25)
Case Weihnacht2
Holiday = DateSerial(TestYear, 12, 26)
Case Else
Err.Raise HdErrInvalidHoliday
End Select
End Function

Public

Function IsHoliday(ByVal TestDate As Date, ByVal Holidays As HolidayConstants) As Boolean
Dim nTestHoliday As Long
Dim nTest As Long
TestDate = CLng(CDbl(TestDate))
Select Case Year(TestDate)
Case 1582 To 2499
Case Else
Err.Raise HdErrInvalidYear
End Select
For nTestHoliday = 1 To 21
nTest = 2 ^ nTestHoliday
If (Holidays And nTest) = nTest Then
If Holiday(Year(TestDate), nTest) = TestDate Then
IsHoliday = True
Exit Function
End If
End If
Next 'nTestHoliday
End Function

Public

Function HolidaysOfYear(ByVal TestYear As Integer, ByVal Holidays As HolidayConstants) As Collection
Dim nTestHoliday As Long
Dim nTest As Long
Select Case TestYear
Case 1582 To 2499
Case Else
Err.Raise HdErrInvalidYear
End Select
Set HolidaysOfYear = New Collection
With HolidaysOfYear
For nTestHoliday = 1 To 21
nTest = 2 ^ nTestHoliday
If (Holidays And nTest) = nTest Then
HolidaysOfYear.Add Holiday(TestYear, nTest), CStr(nTestHoliday)
End If
Next 'nTestHoliday
End With
End Function

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Code
27.01.2005 19:30:14
Ramses
Hallo
Der Code funktioniert problemlos und ohne Fehlermeldung.
Wie von "AboutVB" nicht anders zu erwarten

Gruss Rainer
AW: VBA Code
27.01.2005 19:42:19
Heinz
und warum kommt dann diese Fehlermeldung?
Hab von VBA soviel Ahnung wie ne kuh vom Mäusemelken
Danke für Eure Hilfe
AW: VBA Code
27.01.2005 19:40:18
andre
Hallo,
ohne VBA-Kenntnisse würde ich aber nicht noch Code von einer VB-Site laden ...
Der code ist fas i.O., Dein Fehler könnte z.B. daran liegen:
Attribute VB_Name = "modHolidays"
Diese Zeile gehört entweder auskommentiert oder nicht ins Modul.
Außerdem sind das alles Funktionen, die über das Tabellenblatt aufgerufen werden sollten oder aus anderen makros.
Anzeige
AW: VBA Code
27.01.2005 20:01:16
Ramses
Hallo Andre
Das ist das was mich verblüfft, .... diese Zeile kommt im Code eben gar nicht vor !
Gruss Rainer
AW: VBA Code
27.01.2005 20:21:11
andre
Hallo Rainer,
na wenn der Heinz einen exportierten code kopiert und ins modul einfügt steht so manches drin was nicht reingehört ;-) Die stehen doch auch meistens zum Download ...
Grüße, andre
AW: VBA Code
27.01.2005 20:33:19
Heinz
Danke Andre für Deine Weisheiten
Ich dachte die Foren sind zur hilfe da und nicht um sich über andere zu amüsieren
Da es nun immer wieder solche wie Andre gibt sollen sich die doch bitte dahin bewegen wo sie Ihres Gleichen finden.
Aber so bestätigt sich halt mein Bild von der sogenannten "Hilfe" die hier angeblich angeboten wird.
Anstatt den Suchenden zu helfen werden sie hier verarscht.
Werde mich dann zukünftig an Leute wenden die was von dem Fach verstehen da ich auch vermute das A... eben diese nicht hat sonst würde er nicht so einen Quatsch von sich geben
Danke trotzdem für Eure "Nichthilfe"
Heinz
Anzeige
AW: VBA Code
27.01.2005 20:22:06
PeterW
Hallo Rainer,
im zum Download bereitstehenden File schon, in der Zeile vor Option Explicit. ;-)
Gruß
Peter
Aha,... ;:-))
27.01.2005 20:27:15
Ramses
Hallo Peter
ich habs mir nicht angeschaut,... aber was hat das da für eine Funktion ?
Gruss Rainer
AW: Aha,... ;:-))
27.01.2005 20:32:00
PeterW
Hallo Rainer,
das fragst du besser jemanden, der sich mit VB auskennt. ;-) Ich hab das als "Modulname" interpretiert, so wie Hans in seinen Beispielen erwähnt, wo welcher Codeteil hingehört:
bas_Main
Option..
Nach meinen bescheidenen Kenntnissen ist Option Explicit immer die erste Zeile in einem Modul.
Gruß
Peter
Richtig. Danke für die Info. o.T.
27.01.2005 20:34:53
Ramses
...
AW: Richtig. Danke für die Info. o.T.
27.01.2005 20:37:14
Heinz
dito d.D.
b. D. N. W. d. f. D.
So Du Schlaumaier hier ist was für die Grauen Zellen
Lösung behalt ich genauso für mich
Gruß aus Deutschland
Anzeige
Unterste Schublade.....
27.01.2005 20:48:43
Ramses
Hallo
Ich habe keine Ahnung wo dein Problem ist,... aber damit hast du dich gerade qualifiziert.
Wenn du alle Beiträge gelesen hättest, dann hättest du bemerkt da in Peters letztem Beitrag die Lösung steht.
Aber anyway.... es ist nicht mein Problem wenn du dich übernommen hast.
Trotzdem mit Gruss
Rainer
AW: Unterste Schublade.....
27.01.2005 21:22:57
andre
... ich weiß auch nicht was der hat. Da gibt man ihm die Antwort (und nicht nur Peter) und er beschwert sich noch. Wenn ich mich auf sein Niveau begeben würde würde ich auch ein paar Abkürzungen à la YMCA einstellen. Aber ich tu's nicht.
Grüße, andre
AW: Richtig. Danke für die Info. o.T.
27.01.2005 22:06:58
andre
Hallo Peter,
fast richtig. Option Explicit ist die erste ausführbare Zeile. Drüber kannst Du 14 Meter Kommentar schreiben - falls das für Excel nicht zuviel wird ;-)
Grüße, andre
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige