Habe ein kompliziertes Problem. Ich habe eine Mappe ("Gravurliste"), die nach dem ausfüllen einiger Zellen im 1. Blatt, per Commandbutton unter dem Zellinhalt einer bestimmten Zelle, unter einem festgelegten Pfad (D:\Sasch\Excel\Gravurlisten) gespeichert werden soll. Danach werden in dieser Kopie ("A999999") ab dem 2. Blatt einige Spalten, deren Wert der Zelle1 "leer oder "0" ist, ausgeblendet. Dann werden alle Zellbezüge mit dem 1. Blatt in Werte umgewandelt und das erste Blatt wird gelöscht. Dann werden alle Blätter geschütz und die Mappe geschützt. Soweit gehts auch (Dank Axel aus diesem super Forum).
Jetzt soll aber die Kopie nochmal in dem gleichen Pfad mit den ganzen Veränderungen, unter gleichem Namen gespeichert werden. Das funktioniert noch nicht. Die Originalmappe ("Gravurliste") ist Excel2000, die Kopie sollte aber Wahlweise Excel5.0, Excel8.0 oder Excel9 sein (dazu kann ich ja 3 Buttons benutzen, wo immer nur der letzte Teil des Codes Verändert ist)
Kann sich Jemand dieses Problems annehmen, ich habe fast keine Ahnung von VBA.
Option Explicit
Private Sub ArbeitSpeichern_Click()
Dim spaArray As Variant
Dim i As Integer
Dim n As Integer
Dim strFileNameCopy As String, strLinkCompare
Dim rng As Range, rngFormula As Range
Dim wbCopy As Workbook
' Bildschirmaktualisierung unterdrücken
Application.ScreenUpdating = False
' Dateinamen für Kopie der Mappe festlegen
strFileNameCopy = "D:\Sascha\Excel\Gravurlisten\" & _
ThisWorkbook.Sheets("Artikel").Range("D8") & ".xls"
' Kopie erstellen
ThisWorkbook.SaveCopyAs strFileNameCopy
' Kopie öffnen
Workbooks.Open strFileNameCopy
spaArray = Array("E", "G", "I", "K", "M", "O", "Q", "S", "U", _
"W", "Y", "AA", "AC", "AE", "AG", "AI")
' zunächst den Mappen- und Blattschutz aufheben
' dies kann entfallen, wenn die Quellmappe keinen
' Schutz aufweist
ActiveWorkbook.Unprotect "Schutz"
For i = 1 To Sheets.Count
Sheets(i).Unprotect "Schutz"
Next i
' Spalten ausblenden
For i = 2 To Worksheets.Count
For n = LBound(spaArray) To UBound(spaArray)
With Worksheets(i).Columns(spaArray(n))
' Spalte ausblenden, wenn die erste Zelle der Spalte leer
' ist oder den String "0" enthält
.Hidden = (IsEmpty(.Cells(1)) Or .Cells(1) = "0")
End With
Next n
Next i
' Verknüpfungen auf das Artikelblatt entfernen
' es wird vorausgesetzt, das dieses Blatt das erste der
' Blattaufzählung ist
' Vergleichsstring zusammensetzen
strLinkCompare = "=" & Worksheets(1).Name & "!*" ' liefert "=Artikel!*"
For i = 2 To Worksheets.Count
With Worksheets(i).Cells
' Wenn ein Blatt keine Formeln enthält, entsteht bei
' Anwendung der SpecialCells-Methode ein Laufzeitfehler
' der abgefangen werden muß
On Error Resume Next
Set rngFormula = .SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
' alle Zellen mit Formeln durchlaufen
If (Not rngFormula Is Nothing) Then
For Each rng In rngFormula
' falls eine Verknüpfung enthalten ist
If (rng.Formula Like strLinkCompare) Then
' dann die Formel durch den Zellwert ersetzen
' dadurch wird die Verknüpfung entfernt
rng.Formula = rng.Value
End If
Next
End If
End With
Next i
' Warnungen deaktivieren
Application.DisplayAlerts = False
' erstes Blatt der Mappe entfernen
Worksheets(1).Delete
' Schutz setzen
For i = 1 To Sheets.Count
Sheets(i).Protect "Schutz", DrawingObjects:=True, _
Contents:=True, Scenarios:=True
Sheets(i).EnableSelection = xlUnlockedCells
Next i
ActiveWorkbook.Protect "Schutz", Structure:=True, Windows:=False
' neu speichern im Standard-Excel-Format
ActiveWorkbook.SaveAs Filename:=strFileNameCopy, FileFormat:=xlWorkbookNormal
' Warnungen wieder aktivieren
Application.DisplayAlerts = True
' und danach schliessen
' ActiveWorkbook.Close
End Sub
Vielen Dank
mfg, Sascha