Hallo Forum,
ich habe einen dynamischen, endlosen Kalender (hier: Urlaubsplaner) und möchte, dass sich dieser entweder von selbst immer im Dezember als PDF speichert oder zumindest ab Mitte Dezember eine Message-Box zur Erinnerung der manuellen Speicherung hervorruft, damit die Daten des aktuellen Jahres nicht beim Jahresübertritt verloren gehen.
Also ich brauche quasi einen Code, der sich unabhängig von der Jahreszahl nur auf einen Tag im Monat oder auf den Monat selbst bezieht und dann eine Aktion auslösen kann.
Ich habe dazu im Netz schon folgenden Code gefunden, wobei ich hier auf die fixe Angabe des Jahres angewiesen bin, was ja im dyn. Kalender nicht geht...
Sub Jahresexport()
Dim datKontrolle As Date
datKontrolle = DateSerial(2009, 6, 20)
If Date = datKontrolle Then
MsgBox "Makro wird ausgeführt"
Else
MsgBox "falsches Datum"
End If
End Sub
Könnt ihr euch da ein Konstrukt vorstellen, wie ich das am besten für einen dynamischen Urlaubskalender lösen kann, damit die aktuellen Daten des jeweiligen Jahres nicht verloren gehen?
Viele Grüße
Micha
Hi Micha,
jedes Jahr am 31.12.
Code:
datKontrolle = DateSerial(Year(Date), 12, 31)
Hallo Micha,
für Dein Anliegen ist die Sub Jahresexport() mehr als ungeeignet, denn die muss immer erst gestartet werden, damit die Erinnerung - an welchem Tag auch immer - erscheint.
Sinnvoller ist da ein automatischer, zeitabhängiger Makrostart mit z.B. Sub Worksheet_Selection(ByVal As Range) oder Sub WorkSheet-SelectionChange(ByVal as Range).
Hallo,
Zitat:ich habe einen dynamischen, endlosen Kalender (hier: Urlaubsplaner)
unter einem dynamischen, endlosen Kalender verstehe ich aber etwas anderes. Wenn du das Kalendarium horizontal anordnest, reicht das für rund 44 Jahre, bei einer vertikalen Anordnung sogar für rund 2870 Jahre. Wozu also jedes Jahr eine Sicherung? Es reicht doch, alles auszublenden, was nicht aktuelles Jahr ist.
Hallo Günter,
vielen Dank für den Vorschlag!
Das hört sich plausibel an, aber wie könnte ich das für meinen Fall konkret weiterprogrammieren?
Ich kenne mich mit selection oder selection_change leider nicht aus...
Kannst du mir noch beim Einstieg helfen?
Viele Grüße
Micha
@Glausius,
Zitat:für Dein Anliegen ist die Sub Jahresexport() mehr als ungeeignet...
diese Sub ist genauso (
un-)geeignet wie die von Dir genannten Ereignisse. Denn auch die müssen erst angestoßen werden. Vor allem scheint es mir überflüssig zu sein, das bei jeder Änderung starten zu wollen. Wenn schon, dann wäre eine einmalige Prüfung im Open Ereignis des Workbooks, ob das Vorjahr schon gespeichert wurde, sinnvoll. Falls nicht, dann kann der Jahresexport aufgerufen werden.
Wie dem auch sei, ob das Ganze generell sinnvoll ist, lasse ich mal dahingestellt...
Hallo Micha,
zum Bespiel so:
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Month(Date) <> 12 Or Day(Date) < 15 Then Exit Sub
ActiveWorkbook.Save
Exit Sub
Dieser Code gehört hinter das Kalendertabellenblatt. Es ist jetzt so eingestellt, dass der Kalender automatisch immer nach dem 15.12. bis zum 31.12. eines jeden Jahres gespeichert wird. Gebenenfalls musst du das anpassen (oder anpassen lassen), ebenso einen anderen Speicherort.
Ralf und Günter,
eure Lösungen bzw. Ansätze finde ich beide interessant.
Ich hab es jetzt dennoch mit Günters selection_change umgesetzt, da mir die andere Variante leider noch zu schwer fällt.
Aber es funktioniert soweit.
Danke allen Mitwirkenden!
...ist keine Hexerei.
Im Beispiel wird einmalig beim Öffnen der Datei und auch nur im Januar (falls keiner im Dezember die Datei geöffnet hatte) geprüft, ob es eine Datei vom 32.12. des Vorjahres gibt. Wenn nicht, wird sie erstellt.
Aber Achtung! Bestehende Datei hat dann diesen Namen. Soll sie umbenannt werden, z. Bsp. in 1.1. dieses Jahr, dann muss das noch erledigt werden. Automatisch oder manuell, das ist egal...
Code gehört in das Modul "DieseArbeitsmappe"
Code:
Private Sub Workbook_Open()
Dim Datei As String
If Month(Date) = 1 Then 'Nur im Januar prüfen
'ob es eine Datei mit Namen 31_12_2021 (also statt 2021 das Vorjahr) im angegebenen Ordner gibt
'Pfad und ggf. Dateinamen anpassen!
Datei = "C:\Users\ich\OneDrive\Dokumente\Excel\" & Replace(CStr(DateSerial(Year(Date) - 1, 12, 31)), ".", "_") & ".xlsm"
'wenn nicht, dann unter diesem Namen speichern
If Not CheckFileExists(Datei) Then ThisWorkbook.SaveAs Filename:= _
Datei, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End If
End Sub
Function CheckFileExists(Datei As String) As Boolean
Dim strFileExists As String
strFileExists = Dir(Datei)
CheckFileExists = IIf(strFileExists = "", False, True)
End Function