Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
400to404
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
400to404
400to404
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Kompliziertes VBA-Problem, Speichern per Button

Kompliziertes VBA-Problem, Speichern per Button
Sascha
Hi Leute!
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

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Kompliziertes..... , nur Hinweis
Hajo_Zi
Hallo Sascha
durch Deinen zweiten Beitrag ist Dein Beitrag aus der Liste der offenen Beiträge raus, da Du selber ja eine Antwort gegeben hast. Benutze Datei-Upload in der linken Leiste zum hochladen bevor Du den Beitrag schreibst.
Wandert Dein Beitrag im laufe es Tages weiter nach unten sieht keiner mehr das er noch offen ist.
Bei DEiner Variante solltest Du im zweien Beitrag die Checkbox "Thread weiter anzeigen" aktivieren. Bleibst Du ein wenig länger auf dem Text, wird auch eine Tip dazu angezeigt.


Anzeige
AW: Kompliziertes VBA-Problem, Speichern per Button
Oberschlumpf
Hallo Sascha
Wenn ich Dich bei diesem vielen Text richtig verstanden habe, dann möchtest Du einfach nur die Kopie der Ursprungsdatei automatisiert unter verschiedenen XL-Formaten speichern können?
Wenn dem so ist, dann schau Dir mal diese Datei an.
https://www.herber.de/bbs/user/4500.xls
Ich habe zwei weitere Speicher-Button hinzugefügt, den Code aus dem ersten Button in ein eigenes Sub eingefügt und für jeden einzelnen Button dann das XL-Format vorgegeben und dann ActiveWorkbook.SaveAs ...
Ich hoffe, dass das Dein Prob war und ich Dir helfen konnte.
Ciao
Thorsten
Anzeige
AW: Kompliziertes VBA-Problem, Speichern per Button
Sascha
Hi Thorsten!
Genau das war es, Danke!
Sascha

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige