Probleme mit Code
23.02.2006 20:28:03
Petra
ich habe Probl. mit dem unten stehenden Code der bislang auf Excel97 tadelos seinen Dienst tat. Nun wurde auf dem Rechner Office XP installiert und sofort gab es Ärger mit dem sonst zuverlässigen Code.
Und zwar in den Zeilen 19 - 22 , nach deaktivierung der Zeilen läuft er einwand frei.Nur es werden auf der Kopie der Blatt Code mit übernommen.
Ich euch bitten mir zu helfen.
Gruss Petra
Sub Blatt1Kopieren()
Dim strPath As String
Dim strName As String
Dim strWert As String
Dim shp As Shape
ActiveSheet.Unprotect
strPath = "D:\Eigene Dateien\Sicherung_xls\" 'Pfad
strName = ActiveSheet.Name 'Tabellenname
strWert = ActiveSheet.Range("A1") 'Dateiname - zusatz
Application.ScreenUpdating = False
ActiveSheet.Copy
With ActiveWorkbook
For Each shp In Sheets(1).Shapes 'Schaltflächen entfernen
shp.Delete
Next
Sheets(1).Cells.Copy ' Formeln auf Copy entfernen
Cells.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'With .VBProject.VBComponents(.VBProject.VBComponents(2).CodeModule).CodeModule 'VBA Projecte entfernen
' .DeleteLines 1, .CountOfLines
'End With
.Sheets(1).Cells.Locked = True 'Zellen sperren
.Sheets(1).Protect "test" 'Blattschutz setzen - Passwort anpassen
.SaveAs strPath & strName & " " & Format(Date, "dd-mm-yy") & " " & _
strWert & ".xls"
MsgBox " Kopie von " & strName & " " & strWert & " wurde angelegt "
MsgBox " Das Blatt 1 wird nun gedruckt 1 Kopie"
.Close
End With
Application.ScreenUpdating = True
ActiveSheet.Protect
Sheets("Blatt1").Select
ActiveSheet.Unprotect
Application.ScreenUpdating = False
ActiveSheet.PageSetup.PrintArea = "$A$1:$AF$40"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=Tr
Range("N3:P3,U3,A7:AF31,Z34,S35:S39,H34:J40") = ""
ActiveSheet.Protect
Application.ScreenUpdating = True
End Sub