AW: Laufzeitfehler 50289
13.08.2004 09:56:09
Helga
Hallo guten Morgen Ulf, danke für deine Antwort.
Ich habe unten den Code eingefügt,das urige dabei ist, das der Code Eigenartigerweise mehrfach ausgeführt wird und dann urplötzlich diese Fehlermeldung erscheint.
Also ich sag mal z.Bsp. 10 mal klappt's beim 11 mal nicht.
MfG Helga
Sub Blatt1Kopieren()
Dim strPath As String
Dim strName As String
Dim strWert As String
Dim shp As Shape
ActiveSheet.Unprotect
strPath = "C:\Winnt\Profiles\xflb21\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 entfrnen
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