Ich habe das Problem, dass ich eine Tabelle mit Blattschutz habe. Auf dieser ändert aber folgendes Makro die Zellen-Farbe, wofür ich den Passwortschutz deaktiviere und anschließend wieder aktiviere.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$11" Then Call Laenge
End Sub
Private Sub Laenge()
Me.Unprotect "passwort"
If Range("B11").HasFormula = True Then
CommandButton1.Visible = False
Range("B11").Interior.ColorIndex = 9
Else:
CommandButton1.Visible = True
Range("B11").Interior.ColorIndex = 1
End If
Me.Protect "passwort"
End Sub
Jetzt möchte ich aber am Ende dieses Tabellen-Blatt ohne Formeln und Verweise in ein leeres Dokument kopieren. Dafür benutze ich folgendes Makro:
Private Sub Ausgabe_Deutsch_erstellen()
'Kopiert das Blatt nur mit Inhalten in eine neue Datei
Dim wkb1 As Workbook
Dim wkb2 As Workbook
Dim i As Integer
Dim n As Variant, a As Variant, t As Variant
Dim dlg As Boolean
Dim mldg
Set wkb1 = ActiveWorkbook
Set wkb2 = Application.Workbooks.Open("C:\Vorlagen\Excel_CD.xls")
'--Bildschirmaktualisierung ausschalten. Am Ende aktivieren!--
Application.ScreenUpdating = False
'Tabellenblatt in neue Datei kopieren
wkb1.Sheets("Ein-_Ausgabe_Deutsch").Copy Before:=wkb2.Worksheets(1)
'Formeln löschen über "Kopieren" und "Inhalte einfügen"
wkb2.Sheets("Ein-_Ausgabe_Deutsch").Cells.Copy
wkb1.Unprotect "passwort"
wkb2.Unprotect "passwort"
With ActiveWorkbook.ActiveSheet.Cells
.PasteSpecial Paste:=xlPasteValues 'Werte einfügen
.PasteSpecial Paste:=xlFormats 'Formate einfügen
End With
wkb1.Protect "passwort"
'Name des Blattes ändern
ActiveSheet.Name = "Verbrauchswerte"
'Makro-Code komplett löschen
For i = wkb2.VBProject.VBComponents.Count To 1 Step -1
n = wkb2.VBProject.VBComponents(i).Name
a = wkb2.VBProject.VBComponents(i).CodeModule.CountOfLines
If a > 0 Then
wkb2.VBProject.VBComponents(i).CodeModule.DeleteLines 1, a
End If
t = wkb2.VBProject.VBComponents(i).Type
If t False Then dlg = True
If dlg = True Then
'Datei speichern
ActiveWorkbook.SaveAs Filename:=FileSave
MsgBox "Die Datei wurde erfolgreich gespeichert!", 64
'Dialog ist wahr - Loop verlassen
Exit Do
End If
'Frage ob Speichern wirklich abgebrochen werden soll.
If dlg = False Then
mldg = MsgBox("Bitte Speichern Sie die erstellte Datei." & Chr(10) & _
"Wenn Sie Abbrechen geht die erstellte Datei verloren." & Chr(10) & _
Chr(10) & _
"Wollen Sie das Speichern wiederholen?", vbQuestion + vbRetryCancel)
End If
'Datei wurde nicht gespeichert - Abbruch war erwünscht.
If mldg = vbCancel Then
MsgBox "Die Datei wurde nicht gespeichert!", 16, "Abbruch"
Exit Do 'Wenn Abbruch, Schleife verlassen
End If
Loop
'Datei schließen ohne speichern
ActiveWorkbook.Close (False)
End Sub
Jetzt habe ich natürlich das Problem, dass wenn ich mein Makro laufen lasse, es an dieser Stelle hängen bleibt. Da ja der Blattschutz schon wieder aktiv ist. (Durch das Change Ereignis)
With ActiveWorkbook.ActiveSheet.Cells
.PasteSpecial Paste:=xlPasteValues 'Werte einfügen
.PasteSpecial Paste:=xlFormats 'Formate einfügen
End With
Gibt es da eine Möglichkeit, über mein "Kopier"-Makro das WKS_Change-Ereignis zu verhindern?
Vielen Dank!
Grüße Marc