CommandButton mit aktueller Jahreszahl
22.01.2007 07:59:51
Heinz
Habe unteres Markro das mir ein neues Tab.Blatt mit Aktueller Jahreszahl anlegt.
Meine Frage: Ist es möglich das der CommandButton3 ebenfalls mit der Aktuellen Jahreszahl angezeigt wird.
Zb. "WOMAT" 2007 - "WOMAT" 2008 usw...
Oder gäbe es eine andere Lösung ?
Danke im voraus für Eure Hilfe.
Gruß Heinz
Private Sub CommandButton3_Click()
' Neuses Blatt "WoMat" für ein bestimmtes Jahr anlegen
' Vorgangsweise:
' Abfrage des Jahres für das neue Blatt 'WoMat' ---> Jahr
' Kopie des bestehenden Blattes 'WoMat' erstellen
' bestehendes Blatt 'WoMat' umbenennen auf 'WoMat_xxxx', xxxx = Jahr - 1
' Kopie umbenennen auf 'WoMat' und Daten löschen
' Datum und Tag (Beginnend mit Sonntag) eintragen
'Sub Neues_Womat_erzeugen()
Dim Jahr As Integer
Dim diffTag As Integer
' Jahr abfragen
Do
Jahr = Application.InputBox("Bitte das Jahr für das zu erstellende neue Blatt 'WoMat' " & vbCrLf & _
"eingeben [Format: JJJJ]. Eingabe '0' oder 'Abbrechen'" & vbCrLf & _
"beendet das Programm.", "Jahr eingeben", Year(Now), Type:=1)
If Jahr = 0 Then Exit Sub
Loop Until Len(CStr(Jahr)) = 4
' Kopie erstellen, bestehendes Blatt unbenennen
With Sheets("WoMat")
.Copy Before:=Sheets(2)
.Name = "WoMat" & "_" & CStr(Jahr - 1)
End With
' Kopie auf 'WoMat' umbenennen
Sheets("WoMat (2)").Name = "WoMat"
' eventuelle Daten löschen
With Worksheets("WoMat")
.Unprotect
Application.ScreenUpdating = False
For n = 3 To 1979 Step 38 ' Für ganzes Jahr - 53 Wochen
.Range("B" & n & ":AX" & n + 34).ClearContents
Next n
' Datum eintragen
' Differenz Wochentag des 1.1. zu Sonntag
diffTag = Weekday(DateSerial(Jahr, 1, 1)) - 1 ' Mo=1, Di=2, Mi=3 ...
X = 0
For n = 5 To 1981 Step 38 ' Für ganzes Jahr - 53 Wochen
Cells(n + 0, 1) = "So"
Cells(n + 1, 1) = CDate(DateSerial(Jahr, 1, 1 + X - diffTag))
Cells(n + 5, 1) = "Mo"
Cells(n + 6, 1) = CDate(DateSerial(Jahr, 1, 2 + X - diffTag))
Cells(n + 10, 1) = "Di"
Cells(n + 11, 1) = CDate(DateSerial(Jahr, 1, 3 + X - diffTag))
Cells(n + 15, 1) = "Mi"
Cells(n + 16, 1) = CDate(DateSerial(Jahr, 1, 4 + X - diffTag))
Cells(n + 20, 1) = "Do"
Cells(n + 21, 1) = CDate(DateSerial(Jahr, 1, 5 + X - diffTag))
Cells(n + 25, 1) = "Fr"
Cells(n + 26, 1) = CDate(DateSerial(Jahr, 1, 6 + X - diffTag))
Cells(n + 30, 1) = "Sa"
Cells(n + 31, 1) = CDate(DateSerial(Jahr, 1, 7 + X - diffTag))
X = X + 7
Next n
.Protect
End With
End Sub