Telefonplan für die Woche
14.01.2017 11:35:55
Armando
Ihr habt echt hier ein super Forum geschaff, dass man auch ohne Kentnisse in VBA, trotzdem noch einiges (mit ein wenig Übung) zustande bringen kann.
Ich erkläre erst mal was ich bräuchte und muss sagen, dass ich echt 0 Ahnung von VBA habe aber ich will mich mit dem Thema beschäftigen bzw. ich hab schon angefangen.
Ich habe einen Telefonplan, welches 5 Blätte von Montag bis Freitag beinhaltet. In diesem Telefonplan werden von 8:00 bis 18:00 in je 30 min schritten einen T eingetragen. Links stehen die Namen der Personen von oben nach unten und oben stehen die Zeiten in 30 min (8:00 - 8:30... usw.) Es soll erreicht werden, dass man maximal eine bestimmte Anzahl von Personen eintragen dürfen. Diese funktion wird aber umgegangen sofern man die Draganddrop funktion mit der Maus nutz, dass aber nicht so schlimm ist da manchmal halt eine Überdeckung sich nicht vermeiden lässt.
Nun haben wir aber oft das Problem, dass bestimmte Personen sich nicht an den Regeln halten und noch am gleichen Tag deren Telefondienst einfach ändern und erzeugen dadurch eine Unterdeckung, obwohl gesagt wurde, dass man keine Änderung am gleichen Tag ohne Genehmigung des Vorgesetzen machen darf.
Nun habe ich die Idee gehabt, sämtliche Änderungen durch einen Extra Blatt (hier "Protokoll")zu Protokollieren welches nur bestimmte User einsehen dürfen. Propblem ist aber dass genau die DragandDrop funktion nicht protokolliert wird, sofern man diese Funktion mehr als 2 Felder nutzt. Nun könnte man diese Funktion komplett abschalten und die Angrenzung des Wertes entfernen da ja sowieso dann alles protokolliert wird (bitte erst mal den Punkt Datenschutz bei seite legen da dieses noch geklärt wird).
Eine andere Möglichkeit wäre einfach das Blatt zu schützen sobald das heutige Datum erreicht wurde. Jedes Blatt hat einen Datum und die =Jetzt() funktion so, dass wenn jetzt größer ist als das Datum im Blatt, das ganze Blatt gesperrt wird. Leider hab ich nichts dergleichen gefunden :(.
Damit man gezwungen wird die Makros zu starten (da sonst das alles nicht funktioniert) hab ich alles xlveryhidden und lediglich einen Deckblatt erstellt. Sobald die Makros aktiviert wurde kann man dann im Deckblatt die Schaltfläche anklicken damit folgendes Passiert:
Sub Arbeitsblaetter_einblenden()
'hier werden soweit Makro aktiviert wurden die Arbeitsblätter angezeigt
Worksheets("Montag").Visible = xlSheetVisible
Worksheets("Dienstag").Visible = xlSheetVisible
Worksheets("Mittwoch").Visible = xlSheetVisible
Worksheets("Donnerstag").Visible = xlSheetVisible
Worksheets("Freitag").Visible = xlSheetVisible
Worksheets("start").Visible = xlSheetHidden
'hier werden die Berechtigungen für den Protokoll vergeben ("user")
If Environ("username") = "xxx" Then 'user anpassen!
Worksheets("Protokoll").Visible = xlSheetVisible
End If
'##Application.CellDragAndDrop = False 'hier wird das ziehen mit der Maus verhindert
End Sub
das klappt auch echt wunderbar da sobald jemand was ändert ja alles protokolliert wird durch
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim ErsteFreieZeile As Long
If Target.Count > 1 Then Exit Sub
If Sh.Name = "Protokoll" Then Exit Sub
If Intersect(Target, Sh.Range("C9:V55")) Is Nothing Then Exit Sub
With Sheets("Protokoll")
ErsteFreieZeile = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(ErsteFreieZeile, 1) = Sh.Name
.Cells(ErsteFreieZeile, 2) = Target.Address(0, 0)
.Cells(ErsteFreieZeile, 3) = Target.Value
.Cells(ErsteFreieZeile, 4) = Date
.Cells(ErsteFreieZeile, 5) = Time
.Cells(ErsteFreieZeile, 6) = Environ("username")
End With
End Sub
und dann speichern will folgendes passiert:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
Cancel As Boolean)
a = MsgBox("Möchten Sie wirklich speichern?", vbYesNo)
If a = vbNo Then Cancel = True
Worksheets("Protokoll").Visible = xlSheetVeryHidden
Worksheets("start").Visible = xlSheetVisible
Worksheets("Montag").Visible = xlSheetVeryHidden
Worksheets("Dienstag").Visible = xlSheetVeryHidden
Worksheets("Mittwoch").Visible = xlSheetVeryHidden
Worksheets("Donnerstag").Visible = xlSheetVeryHidden
Worksheets("Freitag").Visible = xlSheetVeryHidden
End Sub
Man muss sagen, dass ich echt keine Ahnung davon habe und lediglich durch eure Hilfe und logisches Denken das hingekriegt habe.
Könnt ihr mir helfen und mir einen Tipp geben, dass sobald ein Datum erreicht wurde keine Änderungen mehr möglich sind? Ich hab nun im Blatt im Feld "X1" die Formel drin wenn das Datum "jetzt"(A1) älter ist als das Datum im Blatt (R1) dann einen bestimmten Wert ausgegeben wird. Wenn dieser Wert = 0 (X1) ist dann soll das Blatt "passwort geschutzt" werden so, dass lediglich der Vorgesetze die Änderungen am gleichen Tag durchführen kann. Somit könnte man das Protokoll sparen da ich dadurch genau das verhindere was ich möchte oder gibt es einen VBA Code der sies ermöglich?
Bitte denkt dabei, dass ich echt keine ahnung davon habe :D Ihr könnt auch gerne eure Anregungen und Verbessrungsvorschläge mitteilen.
Vielen Dank und schönes Wochenende :)