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
872to876
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
872to876
872to876
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Abbrechen funkt. nicht

Abbrechen funkt. nicht
23.05.2007 20:42:21
Heinz
Hallo Leute
Habe unteres Makro zum erstellen eines neuen Tab.Blatt bekommen.
Nur funkt.das abrechen nicht.
Wenn ich auf Abbrechen klicke wird trozdem ein neues Blatt eingefügt.
Könnte mir Bitte jemand helfen ?
Danke & Gruß Heinz

Private Sub CommandButton2_Click()
' Anfang *******************************************************************************
' Erstellt ein beliebiges Jahresblatt und benennt es in der Form 'WoMat_JJJJ'
' Um auf diesem Blatt Eintagungen vornehmen zu können, muß das bestehende
' Tabellenblatt 'WoMat' umbenannt bzw. gelöscht werden. Das neu erzeugte
' Blatt dann in 'WoMat' umbenennen.
' Beliebiges WoMat - Jahr erstellen
'Sub Neues_woMat()
Dim Vorgabe%, Jahr, n%, x%
Dim Datum As Date
Vorgabe = Year(Now) + 1
' Abfrage des Jahres
Jahr = Application.InputBox("Geben Sie das Jahr für ein neues WoMat-Blatt ein.", _
"Jahr eingeben", Vorgabe, , , , 1)
' ganzes Blatt kopieren und umbenennen
Sheets("WoMat").Copy After:=Sheets(2)
Sheets("WoMat (2)").Name = "WoMat_" & CStr(Jahr)
' Sonntag ermitteln
n = 0
Do
Datum = DateSerial(Jahr, 1, 1 - n)
n = n + 1
Loop Until Weekday(Datum) = vbSunday
Dim Jj%, Mm%, Dd%
Jj = Year(Datum): Mm = Month(Datum): Dd = Day(Datum)
With Sheets("WoMat_" & CStr(Jahr))
' eventuellen Blattschutz aufheben
On Error Resume Next
.Unprotect
' Datum und Tage eintragen
x = 0
For n = 5 To 1981 Step 38  ' Für ganzes Jahr - 53 Wochen
.Cells(n + 0, 1) = "So"
.Cells(n + 1, 1) = DateSerial(Jj, Mm, Dd + x)
.Cells(n + 5, 1) = "Mo"
.Cells(n + 6, 1) = DateSerial(Jj, Mm, Dd + x + 1)
.Cells(n + 10, 1) = "Di"
.Cells(n + 11, 1) = DateSerial(Jj, Mm, Dd + x + 2)
.Cells(n + 15, 1) = "Mi"
.Cells(n + 16, 1) = DateSerial(Jj, Mm, Dd + x + 3)
.Cells(n + 20, 1) = "Do"
.Cells(n + 21, 1) = DateSerial(Jj, Mm, Dd + x + 4)
.Cells(n + 25, 1) = "Fr"
.Cells(n + 26, 1) = DateSerial(Jj, Mm, Dd + x + 5)
.Cells(n + 30, 1) = "Sa"
.Cells(n + 31, 1) = DateSerial(Jj, Mm, Dd + x + 6)
x = x + 7
Next n
End With
End Sub


3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
If Jahr = False Then Exit Sub
23.05.2007 20:56:40
Matthias
Hallo

Vorgabe = Year(Now) + 1
' Abfrage des Jahres
Jahr = Application.InputBox("Geben Sie das Jahr für ein neues WoMat-Blatt ein.", _
"Jahr eingeben", Vorgabe, , , , 1)


If Jahr = False Then Exit Sub


' ganzes Blatt kopieren und umbenennen
Sheets("WoMat").Copy After:=Sheets(2)
Sheets("WoMat (2)").Name = "WoMat_" & CStr(Jahr)


Gruß Matthias

AW: Abbrechen funkt. nicht
23.05.2007 20:58:00
Andreas

Sub CommandButton2_Click()
' Anfang *******************************************************************************
' Erstellt ein beliebiges Jahresblatt und benennt es in der Form 'WoMat_JJJJ'
' Um auf diesem Blatt Eintagungen vornehmen zu können, muß das bestehende
' Tabellenblatt 'WoMat' umbenannt bzw. gelöscht werden. Das neu erzeugte
' Blatt dann in 'WoMat' umbenennen.
' Beliebiges WoMat - Jahr erstellen
'

Sub Neues_woMat()
Dim Vorgabe%, Jahr, n%, x%
Dim Datum As Date
Vorgabe = Year(Now) + 1
' Abfrage des Jahres
Jahr = Application.InputBox("Geben Sie das Jahr für ein neues WoMat-Blatt ein.", _
"Jahr eingeben", Vorgabe, , , , 1)
If Jahr = False Then Exit 

Sub 'Abbrechen gibt FALSE zurück, also wenn Jahr = False dann...
' ganzes Blatt kopieren und umbenennen
Sheets("WoMat").Copy After:=Sheets(2)
Sheets("WoMat (2)").Name = "WoMat_" & CStr(Jahr)
' Sonntag ermitteln
n = 0
Do
Datum = DateSerial(Jahr, 1, 1 - n)
n = n + 1
Loop Until Weekday(Datum) = vbSunday
Dim Jj%, Mm%, Dd%
Jj = Year(Datum): Mm = Month(Datum): Dd = Day(Datum)
With Sheets("WoMat_" & CStr(Jahr))
' eventuellen Blattschutz aufheben
On Error Resume Next
.Unprotect
' Datum und Tage eintragen
x = 0
For n = 5 To 1981 Step 38  ' Für ganzes Jahr - 53 Wochen
.Cells(n + 0, 1) = "So"
.Cells(n + 1, 1) = DateSerial(Jj, Mm, Dd + x)
.Cells(n + 5, 1) = "Mo"
.Cells(n + 6, 1) = DateSerial(Jj, Mm, Dd + x + 1)
.Cells(n + 10, 1) = "Di"
.Cells(n + 11, 1) = DateSerial(Jj, Mm, Dd + x + 2)
.Cells(n + 15, 1) = "Mi"
.Cells(n + 16, 1) = DateSerial(Jj, Mm, Dd + x + 3)
.Cells(n + 20, 1) = "Do"
.Cells(n + 21, 1) = DateSerial(Jj, Mm, Dd + x + 4)
.Cells(n + 25, 1) = "Fr"
.Cells(n + 26, 1) = DateSerial(Jj, Mm, Dd + x + 5)
.Cells(n + 30, 1) = "Sa"
.Cells(n + 31, 1) = DateSerial(Jj, Mm, Dd + x + 6)
x = x + 7
Next n
End With
End Sub


Anzeige
Danke An Matthias & Andreas
23.05.2007 21:05:44
Heinz
Hallo Ihr beiden
Recht herzlichen Dank für Eure Hilfe.
Funkt. Wunderprächtig.
Gutes Nächtli,Heinz

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige