Kopieren von Dienstplänen per VBA
17.09.2004 10:44:23
Dienstplänen
Mit folgender Routine lege ich in einem Workbook automatisch neue
Wochendienstpläne an.
Die Routine prüft dabei, ob ein Datum schon angelegt wurde.
Kopiert werden soll ein Leerplan. In diesem sind Verknüpfungen zu einer
Access-Datenbank mit Abfragen, damit das Personal immer aktuell eingetragen
wird.
Außerdem sind 7 Spalten (=Wochentag) eingerichtet.
InC2 soll durch das untenstehende Makro autom. das angelegte Datum
eingetragen werden.
In C3 soll dann c2+6 das Enddatum erscheinen.
In Zelle d2 steht eine SVERWEIS-Formel, denn zusätzlich zum Datum jeder
Spalte befindet sich darunter eine Schichtfolge ABA, BCB, CDC, DAD, welche
in einer Tabelle auf ein Datum zugreift und so entsprechend sich autom.
einstellen soll.
Was nicht funktioniert:
- Die Formeln in C3 und in den Spalten der Wochentage (Beispiel= c2+1, =c2+2
etc...), sowie die SVERWEISE werden offenbar nicht kopiert, denn im neu
angelegten
Plan erscheint nur das angelegte erzeugte Datum.
- Wird das Datum 8-stellig eingegeben haut es mit der Abfrage natürlich
nicht hin. Es müßte also eine Datumsabfrage geben und das Datum soll dann
10-stellig in C2 eingetragen werden.
Jou, ich weiß mir keinen Rat mehr. HÜLFÄÄÄ
Dank vorab
Private Sub CommandButton1_Click()' neuer Plan soll erzeugt werden
Dim x As Object
Dim mldg$, title$
Dim datum As Date
Dim ergebnis%, stil%
Unload frmPWneuerPlan 'Passwortabfrage mit Userform
If TextBox1 = "plaN" Then
Sheets("Wochenplan_Leer").Activate
ActiveSheet.Unprotect password:="plaN"
frmPWneuerPlan.Hide
'anlegen eines neuen leeren Plans
datum = InputBox("Geben Sie bitte den 1. Tag der anzulegenden Woche
an. Beachten Sie das Format (10-stellig), Beispiel: 05.03.2003")
If datum = ("") Then 'Abfrage, bzw. festlegen eines Datums
Exit Sub
End If
For Each x In ActiveWorkbook.Sheets
If x.Name = datum Then
mldg = "Diese Woche wurde offensichtlich schon erfasst, bitte kontrollieren
Sie über die bereits angelegten Pläne!"
stil = vbCritical + vbOKOnly
title = "A C H T U N G ! ! !"
ergebnis = MsgBox(mldg, stil, title)
Sheets("Wochenplan_Leer").Activate
Exit Sub
End If
Next x
ActiveSheet.Copy after:=Worksheets("Wochenplan_Leer")'eigentliches Kopieren
'Worksheets(Worksheets.Count)
Cells.Copy
Cells.PasteSpecial xlPasteValues
Application.CutCopyMode = xlCopy
ActiveSheet.Name = ActiveSheet.[C2]
ActiveSheet.Name = datum
ActiveSheet.Range("C2") = datum
ActiveSheet.Range("C3").Select
ActiveSheet.Protect password = "plaN"
Sheets("WoDiPlanStart").Activate
ActiveSheet.Range("a1").Select
Application.ScreenUpdating = True
Else
MsgBox ("Falsches Passwort!")
Exit Sub
End If
End Sub