Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.10.2025 10:28:49
16.10.2025 17:40:39
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Drucken

Forumthread: Drucken

Drucken
JensZ
Hallo
und gleich noch ne frage
da ich mich nicht auskenne in VBA.
ich habe in diesen forum einen code gefunden (Danke für den ersteller)
über das Drucken eines Tab.-Blattes was gleich eine Sicherungkopie macht.
ist es möglich ein abfragefenster einzubinden unter welchen Namen und auf welches laufwerk ich es speichern möchte?
hier der code:
Option Explicit
Const SicherungsDatei = "Sicherung.xls"

Private Sub CommandButton4_Click()
Dim Anz, Neu As Integer
Dim Dummy As String
Application.ScreenUpdating = False
On Error GoTo ok
Dummy = Workbooks(SicherungsDatei).Name 'Abfrage zum Fehler erzeugen, wenn nicht vorhanden
'kein Fehler = FEHLER: Datei schon vorhanden!
MsgBox "Sicherung kann nicht durchgeführt werden, da eine Datei mit Namen " & SicherungsDatei & _
" schon geöffnet ist." & Chr(10) & _
"Schließen Sie diese Datei und wiederholen sie den Vorgang.", vbCritical, "Fehler bei der Sicherung"
Exit Sub
ok:
On Error GoTo 0
Anz = Workbooks.Count
Sheets("Druckvorschau").Copy
Workbooks(Anz + 1).Activate
Cells.Copy
Cells.PasteSpecial xlPasteValues
Application.CutCopyMode = False
'Prüfe, ob Datei schon existiert:"
'Ja
If Dir(ThisWorkbook.Path & "\" & SicherungsDatei) <> "" Then
If MsgBox("Die Datei " & SicherungsDatei & " existiert schon. Überschreiben?", vbYesNo + vbQuestion) = vbNo Then
MsgBox "Die Sicherungsdatei konnte nicht gespeichert werden!", vbCritical, "Fehler beim Speichern"
ActiveWorkbook.Close SaveChanges:=False 'schließt Kopie ohne Speichern
Exit Sub
Else
Kill ThisWorkbook.Path & "\" & SicherungsDatei
End If
End If
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & SicherungsDatei
'Kopie drucken?
If MsgBox("Soll die Kopie gleich gedruckt werden?", vbYesNo + vbQuestion, SicherungsDatei) = vbYes Then
ActiveSheet.PrintOut
End If
'Kopie schließen
ActiveWorkbook.Close
MsgBox "Kopie erfolgreich unter " & ThisWorkbook.Path & "\" & SicherungsDatei & " gespeichert.", vbInformation, SicherungsDatei
Application.ScreenUpdating = True
End Sub

Gruß jens
Anzeige

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Drucken
Uwe
Hallo, Jens!
Du müsstes vor dem "Dir"-IF-Abfrageblock die Methode GetSaveAsFilename des Application-Objects einbauen.
Ein Vorschlag zu Änderung wäre:
...
'Prüfe, ob Datei schon existiert:"
'Ja
Dim DateiName As String
DateiName = Application.GetSaveAsFilename( _
InitialFileName:=ThisWorkbook.Path & "\" & SicherungsDatei, _
FileFilter:= _
"Excel-Dateien (*.xls), *.xls," & _
"beliebige Dateien (*.*), *.*", _
FilterIndex:=1)
If DateiName = "Falsch" Then
MsgBox ("Es wird keine Sicherung durchgeführt!")
Exit Sub
End If
If Dir(DateiName) <> "" Then
If MsgBox("Die Datei " & SicherungsDatei & " existiert schon. Überschreiben?", vbYesNo + vbQuestion) = vbNo Then
MsgBox "Die Sicherungsdatei konnte nicht gespeichert werden!", vbCritical, "Fehler beim Speichern"
ActiveWorkbook.Close SaveChanges:=False 'schließt Kopie ohne Speichern
Exit Sub
Else
Kill DateiName
End If
End If
ActiveWorkbook.SaveAs Filename:=DateiName
'Kopie drucken?
....


Gruß!
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige