AW: Makros auf excel professional plus 2013 / office
31.01.2018 16:56:39
Ralf
Hi Freddy,
2 Monate und schon Userforms programmieren? Respekt!
Das Problem wird Dir sicher noch häufiger begegnen. Du verwendest Funktionen oder Objekte, deren Bibliotheken auf Deinem Rechner installiert/registriert sind, auf anderen Rechnern jedoch nicht.
Bezüglich des Datetimepickers... da bin ich leider nicht auf dem Laufenden. Früher war es jedenfalls so, dass er erstens von Version zu Version unterschiedlich und somit im schlimmsten Fall in Nachfolheofficeversionen nicht einsatzfähig war, zudem war er nur dann vorhanden, wenn man bei der Installation von Access ausdrücklich diese Option ausgewählt hatte und zu allem Ärger auch noch gegen die Lizenzbedingtungen vom Microsoft verstieß, wenn man ihn einfach so an andere weitergab. Desghalb hatte ich schon vor Jahren mein eigenes Kalendersteuerelement entwickelt. Ich würde es Dir ja geben, nur wird es Dir nicht viel nutzen, da, ich darin nur die deutschen Feiertage berücksichtigt habe.
Ich kann Die aber mal die Feiertagsfunktionen schicken. Wenn Du die an die niederländischen Feiertage anpssen willst, dann kannst Du das ja mal machen und korrigiert zurückschicken, ich würde Dir dann eine Beispieldatei mit dem Steuerelement mal hier einstellen.
Hier der Feiertagscode. Wenn Du magst, kannst Du ihn anpassen:
Bei den festen Feiertagen musst Du mal schauen, was Ihr da so in den Niederlanden habt. Die beweglichen Feiertage (also den kirchlichen), nehmen ja immer Bezug auf Ostern. Da ist es in D so, dass es da unterschiedliche Regelungen in den Bundesländern gibt. Die Tage sind immer dsie gleichen, nur die Anwendung pro Bundesland unterschiedlich... Betrifft die Funktion LookIn und da z. Bsp. Fronleichnam....
'Feste Feiertage....
'aktTag ist das Tagesdatum.... also z. Bsp. die 1 für den 1.1. (Neujahr)
'Variable feiertag nimmt die Feiertagsbezeichnung auf
Public Function Feiertage(ByVal aktTag As Integer, Optional monat As String) As Boolean
If aktTag >= 0 Then
If monat = "" Then
monat = frmKal.cbMonate.Text
End If
On Error GoTo Leer
Ostern
Select Case monat
Case "Januar", "1":
If aktTag = 1 Then
Feiertage = True
feiertag = "Neujahr"
End If
If aktTag = 6 Then
Feiertage = True
feiertag = "Heilige 3 Könige" & vbCrLf & vbTab & "Bayern" & vbCrLf & vbTab & "Baden _
Württemberg" & vbCrLf & vbTab & "Sachsen-Anhalt"
End If
Case "Februar", "März", "April", "Mai", "Juni", "2", "3", "4", "5", "6":
LookIn aktTag, frmKal.cbMonate.ListIndex + 1
If feiertag "" Then Feiertage = True
If aktTag = 1 And frmKal.cbMonate.ListIndex + 1 = 5 Then
Feiertage = True
feiertag = "Tag der Arbeit"
End If
Case "August", "8":
If aktTag = 15 Then
Feiertage = True
feiertag = "Mariä Himmelfahrt" & vbCrLf & vbTab & "Bayern" & vbCrLf & vbTab & " _
Saarland"
End If
If aktTag = 8 Then
Feiertage = True
feiertag = "Friedensfest" & vbCrLf & vbTab & "Nur in Augsburg"
End If
Case "Oktober", "10":
If aktTag = 3 Then
Feiertage = True
feiertag = "Tag der deutschen Einheit"
End If
If aktTag = 31 Then
Feiertage = True
feiertag = "Reformationstag" & vbCrLf & vbTab & "Brandenburg" & vbCrLf & vbTab & " _
Mecklenburg-Vorpommern" _
& vbCrLf & vbTab & "Sachsen" & vbCrLf & vbTab & "Sachsen-Anhalt" & vbCrLf & vbTab & "Thü _
ringen"
End If
Case "November", "11":
If aktTag = 1 Then
Feiertage = True
feiertag = "Allerheiligen" & vbCrLf & vbTab & "Baden-Württemberg" & vbCrLf & vbTab & " _
Bayern" _
& vbCrLf & vbTab & "Nordrhein-Westfalen" & vbCrLf & vbTab & "Rheinland-Pfalz" _
& vbCrLf & vbTab & "Saarland"
End If
If aktTag = 30 - (-Buß_Bet) Then
Feiertage = True
feiertag = "Buß- und Bettag" & vbCrLf & vbTab & "Sachsen"
End If
Case "Dezember", "12":
If aktTag = 25 Or aktTag = 26 Then
Feiertage = True
feiertag = aktTag - 24 & ". Weihnachtsfeiertag"
End If
End Select
End If
Exit Function
Leer:
Err.Clear
End Function
Sub Ostern()
'Sub Ostern(Optional otag As Integer)
Dim x%, a%, b%, c%, d%, e%
Ostersonntag = ""
x = frmKal.cbJahr
a = x Mod 19
b = x Mod 4
c = x Mod 7
d = ((19 * a) + 24) Mod 30
e = ((2 * b) + (4 * c) + (6 * d) + 5) Mod 7
x = 0
If d + e > 9 Then
If d = 28 And a > 10 Then
Ostersonntag = CStr(d + e - 8) & "." & "04"
Else
Ostersonntag = CStr(d + e - 9) & "." & "04"
End If
x = 4
Else
If d + e = 9 Then
Ostersonntag = CStr(22 + d + e) & "." & "03"
Else
Ostersonntag = CStr(22 + d + e) & "." & "03"
End If
End If
End Sub
Sub LookIn(FTag As Integer, monat As Integer)
Dim FT$, t As Date
Dim Original$
feiertag = ""
If Ostersonntag = "" Then Ostern
If Ostersonntag "" Then
If frmKal.cbMonate.ListIndex + 1 = monat Then
FT = "." & VBA.Right(Ostersonntag, 2) & "." & frmKal.cbJahr
Original = Format(FTag, "00") & "." & Format(monat, "00") & "." & frmKal.cbJahr
t = CDate(Ostersonntag & "." & frmKal.cbJahr)
If Original = t Then
feiertag = "Ostersonntag"
ElseIf Original = t - 2 Then
feiertag = "Karfreitag"
ElseIf Original = t + 1 Then
feiertag = "Ostermontag"
ElseIf Original = t - 48 Then
feiertag = "Rosemmontag"
ElseIf Original = t - 46 Then
feiertag = "Aschermittwoch"
ElseIf Original = t + 39 Then
feiertag = "Christi Himmelfahrt"
ElseIf Original = t + 49 Then
feiertag = "Pfingstsonntag"
ElseIf Original = t + 50 Then
feiertag = "Pfingstmontag"
ElseIf Original = t + 60 Then
feiertag = "Fronleichnam" & vbCrLf & vbTab & "Bayern" & vbCrLf & vbTab & "Baden Wü _
rttemberg" _
& vbCrLf & vbTab & "Hessen" & vbCrLf & vbTab & "Nordrhein-Westfalen" & vbCrLf & _
vbTab & "Rheinland-Pfalz" _
& vbCrLf & vbTab & "Saarland" & vbCrLf & vbTab & "teilweise in Thüringen" & vbCrLf & _
vbTab & "teilweise in Sachsen"
End If
End If
End If
End Sub
Function Buß_Bet() As Integer
Dim t As Integer
If Ostersonntag = "" Then Ostern
If Month(Ostersonntag) = 4 Then
t = (30 - CInt(Day(Ostersonntag))) Mod 7
Else
t = (33 - CInt(Day(Ostersonntag))) Mod 7
End If
Buß_Bet = 24 - t - 32
End Function