Schreibschutzproblem
19.05.2005 09:32:26
Christoph
ich habe eine Excel-Datei, welche meist von mehreren Leuten mit Schreibschutz verwendet wird. Mein Problem ist, das ich den Schreibschutz zu Beginn setze und es dann zu einer Fehlermeldung kommt, wenn mehrere Leute die Datei verwenden.
Sub Workbook_open()
'beim öffnen ausführen
i = 0
'nur Leserechte setzen
Application.DisplayAlerts = False
ActiveWorkbook.ChangeFileAccess xlReadOnly
'Worksheets verbergen
Worksheets("Arbeitszeiten").Visible = False
Worksheets("Hilfstabelle").Visible = False
Worksheets("persönlicher Kalender").Visible = False
Worksheets("Report").Visible = False
'zum Schichtplan wechseln
Worksheets("Schichtplan").Activate
'aktuelles Datum suchen
endup = Range("A65536").End(xlUp).Row
For i = 1 To endup
If Worksheets("Schichtplan").Range("D" & i).Value = Date Then 'Wenn Wert in Spalte "D" gleich Date ist
Worksheets("Schichtplan").Range("D" & i).Activate ' springe zur Zelle
For x = 1 To 5
'ältere Zeilenmarkierungen werden aufgehoben
Worksheets("Schichtplan").Range("C" & i - x, "BB" & i - x).Font.Bold = False
Worksheets("Schichtplan").Range("C" & i - x, "BB" & i - x).Borders(xlEdgeBottom).Weight = xlThin
Worksheets("Schichtplan").Range("C" & i - x, "BB" & i - x).Borders(xlEdgeTop).Weight = xlThin
Next x
'aktuelle Zeile wird markiert
Worksheets("Schichtplan").Range("C" & i, "BB" & i).Font.Bold = True
Worksheets("Schichtplan").Range("C" & i, "BB" & i).Borders(xlEdgeBottom).Weight = xlThick
Worksheets("Schichtplan").Range("C" & i, "BB" & i).Borders(xlEdgeTop).Weight = xlThick
Exit Sub
End If
Next i
End Sub
Habt ihr vielleicht ne Idee, wie man solche Probleme abfangen kann?
Gruß
Christoph