Starte ich das erste Mal nach dem öffnen meines Files das Makro, erhalte ich die Fehlermeldung Zugriff verweigert (Laufzeitfehler 70).
Nach schliessen von Debug und nochmaligem Start des Makros, läuft Code Fehlerfrei ab.
Kann mir jemand erklären woran das liegt und wo ich welche Code-Anpassung vornehmen muss.
Liebe Gruess
Richi
Sub Legende()
Dim wsLegende As Worksheet
Dim wsSingleLineView As Worksheet
Dim rng As Range
Dim tmpChart As ChartObject
Dim Passwort As String
' Passwort eingeben
Passwort = "-xxx-"
'--------------------------Startblock zur Geschwindigkeitserhöhung bei Schleifen------------------------
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
' Schleife durch alle Arbeitsblätter in der aktuellen Arbeitsmappe
For Each Ws In ThisWorkbook.Worksheets
' Blattschutz aufheben
On Error Resume Next ' Fehler ignorieren
Ws.UNPROTECT Passwort
On Error GoTo 0 ' Fehlerbehandlung wieder aktivieren
Next Ws
' Arbeitsblatt
Set wsLegende = ThisWorkbook.Sheets("Legende Status")
Set wsSingleLineView = ThisWorkbook.Sheets("Single Line View")
' Setze den Bereich
Set rng = wsLegende.Range("AH2:AP27")
' Kopieren Bereich als Bild
rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
' Füge ein temporäres Diagramm hinzu
Set tmpChart = wsLegende.ChartObjects.Add(Left:=rng.Left, Top:=rng.Top, Width:=rng.Width, Height:=rng.Height)
With tmpChart
.Activate
.Chart.Paste
.Chart.Export Filename:=ThisWorkbook.Path & "\temp_legende.jpg", FilterName:="JPG"
.Delete
End With
' Laden Bild in das Image-Steuerelement
UFLegende.imgLegende.Picture = LoadPicture(ThisWorkbook.Path & "\temp_legende.jpg")
' Entfernen temporäre Datei
Kill ThisWorkbook.Path & "\temp_legende.jpg"
' Wechslen Arbeitsblatt "Single Line View"
wsSingleLineView.Activate
' Schleife durch alle Arbeitsblätter in der aktuellen Arbeitsmappe
For Each Ws In ThisWorkbook.Worksheets
' Blattschutz aktivieren
On Error Resume Next ' Fehler ignorieren
Ws.PROTECT Passwort
On Error GoTo 0 ' Fehlerbehandlung wieder aktivieren
Next Ws
'------------------------------------Endblock zur Geschwindigkeitserhöhung bei Schleifen------------------------------------
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub