AW: Kopie speichern
17.03.2007 01:50:00
fcs
Hallo Snewi,
ich habe dein Makro mal so modifiziert, das in der Kopie für alle Blätter der Blattschutz aktiviert wird. Dabei habe ich 2 Varianten produziert.
Variante 1 (kompliziert):
Wenn du schon mit geschützten Blättern arbeitest, dann werden die ungeschützten Zellen gesperrt und nach dem Erstellen der Kopie wieder entsperrt.
Variante 2 (einfach):
Für alle Blätter wird der Blattschutz vor dem Erstellen der Kopie aktiviert und danach im Original wieder deaktiviert.
Den Schreibschutz für die Datei hattest du im Makro ja schon realisiert.
Was meinst du mit Makroabfrage umgehen? Bei mir Windows98/Excel97 kommt beim Makro keine Abfragemeldung.
Gruss
Franz
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'komplizierte Variante, Tabellen sind normalerweise geschützt, es gibt Zellen mit Format - Schutz deaktiviert
Dim strDatname As String, i As Integer, Diag As Chart, ungeschuetzt() As Range, wks As Worksheet
ReDim ungeschuetzt(ThisWorkbook.Worksheets.Count)
For i = 1 To ThisWorkbook.Worksheets.Count
Set wks = ThisWorkbook.Worksheets(i)
With wks
'Ungeschützte Zellen erfassen
For Each Zelle In .UsedRange
If Zelle.Locked = False Then
If ungeschuetzt(i) Is Nothing Then
Set ungeschuetzt(i) = Zelle
Else
Set ungeschuetzt(i) = Application.Union(ungeschuetzt(i), Zelle)
End If
End If
Next
.Unprotect
If Not ungeschuetzt(i) Is Nothing Then
ungeschuetzt(i).Locked = True
End If
.Protect
End With
Next
For Each Diag In ThisWorkbook.Charts
Diag.Protect
Next
strDatname = ThisWorkbook.Path & "\Untertest\" & ThisWorkbook.Name 'Pfad + Name anpassen
If Dir(strDatname) "" Then SetAttr strDatname, vbNormal
ThisWorkbook.SaveCopyAs strDatname
SetAttr Pathname:=strDatname, Attributes:=vbReadOnly
For i = 1 To ThisWorkbook.Worksheets.Count
Set wks = ThisWorkbook.Worksheets(i)
With wks
.Unprotect
If Not ungeschuetzt(i) Is Nothing Then
ungeschuetzt(i).Locked = False
End If
.Protect
End With
Next
For Each Diag In ThisWorkbook.Charts
Diag.Unprotect
Next
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'einfache Variante, Tabellen sind normalerweise nicht geschütz, es gibt keine Zellen mit Format - Schutz deaktiviert
Dim strDatname As String, Diag As Chart, wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
wks.Protect
Next
For Each Diag In ThisWorkbook.Charts
Diag.Protect
Next
strDatname = ThisWorkbook.Path & "\Untertest\" & ThisWorkbook.Name 'Pfad + Name anpassen
If Dir(strDatname) "" Then SetAttr strDatname, vbNormal
ThisWorkbook.SaveCopyAs strDatname
SetAttr Pathname:=strDatname, Attributes:=vbReadOnly
For Each wks In ThisWorkbook.Worksheets
wks.Unprotect
Next
For Each Diag In ThisWorkbook.Charts
Diag.Unprotect
Next
End Sub