AW: Diagramm-Schutz aufheben: Wie?
21.09.2013 20:24:16
fcs
Hallo Tobias,
soweit ich aus dem Text herauslesen konnte arbeitest du mit im Tabellenblatt eingebetteten Chart-Objekten.
Die Protect- und Unprotect-Methode beziehen sich aber auf Tabellen- oder Diagrammblätter. D.h. man kann den Schutz von eingebetteten Diagrammen nicht separat aufheben/einrichten.
Ich hab beim Testen festgestellt, dass man mit
Worksheets(i).Protect Password:=PWD, UserInterfaceOnly:=True
Einige Einstellungen in den Diagrammen ändern kann - z.B. die Füllfarbe von Datenreihen
Andere Einstellungen bleiben aber gesperrt - z.B. der Text des Diagrammtitels
Dir wird also nichts anderes übrigbleiben, als für die Blätter kurzzeitig während der Ausführung des Makros den Blattschutz zu deaktivieren.
Gruß
Franz
Code-Beispiel mit dem ich verschiedene Schutzeinstellungen probiert hab.
Option Explicit
Private Const PWD = "Test"
Sub Manipuliere()
Dim i, objPoint As Point
Dim objChart As Chart, wks As Worksheet
On Error GoTo Fehler
Application.EnableCancelKey = xlDisabled 'Makro kann nicht per ESC abgebrochen werden
Application.ScreenUpdating = False
'Blattschutz aufheben
For Each wks In ActiveWorkbook.Worksheets
wks.Unprotect Password:=PWD
Next wks
For Each objChart In ActiveWorkbook.Charts
objChart.Unprotect Password:=PWD
Next objChart
'Wertänderungen in Tabelle
For i = 2 To 5
Worksheets(1).Cells(i, 2) = Rnd() * 10
Next
'Anpassung am eingebetteten Diagrammobjekt
Set objChart = Worksheets(1).ChartObjects(1).Chart
With objChart
.ChartTitle.Text = "Werte Stand: " & Format(Now, "YYYY-MM-DD hh:mm")
For i = 1 To 4
Set objPoint = .SeriesCollection(1).Points(i)
objPoint.Format.Fill.ForeColor.RGB = RGB(Red:=Int(Rnd() * 254) + 1, _
Green:=Int(Rnd() * 254 + 1), blue:=Int(Rnd() * 254) + 1)
Next
End With
'Anpassung im Diagrammblatt
Set objChart = Charts(1)
With objChart
.ChartTitle.Text = "Werte Stand: " & Format(Now, "YYYY-MM-DD hh:mm")
For i = 1 To 4
Set objPoint = .SeriesCollection(1).Points(i)
objPoint.Format.Fill.ForeColor.RGB = RGB(Red:=Int(Rnd() * 254) + 1, _
Green:=Int(Rnd() * 254 + 1), blue:=Int(Rnd() * 254) + 1)
Next
End With
Err.Clear
Fehler: 'Fehlerbehandlung
With Err
Select Case .Number
Case 0 'Alles OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
'Blattschutz wieder setzen
For Each wks In ActiveWorkbook.Worksheets
wks.Protect Password:=PWD, UserInterfaceOnly:=True
Next wks
For Each objChart In ActiveWorkbook.Charts
objChart.Protect Password:=PWD, UserInterfaceOnly:=True
Next objChart
Application.EnableCancelKey = xlInterrupt
Application.ScreenUpdating = True
End Sub