Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
616to620
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
616to620
616to620
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

bestehendes Makro (Save as) erweitern

bestehendes Makro (Save as) erweitern
25.05.2005 19:49:05
Max
Hallo,
ich benutze ein Makro (von Uwe D.) aus einem Thread der letzten Tage, um Tabellen
unter dem Kundennamen zu speichern. Funktioniert auch super.
Mir würde es allerdings sehr helfen, wenn es sich dahingehend erweitern läßt,
dass unter dem gleichen Datei-Namen eine Kopie in C:\Backup angelegt wird.
Während ich die "Speichern unter"-Abfrage für das Original brauche, kann die
Backup Kopie über einen im Makro festgelegten Pfad ohne Nachfrage gespeichert
werden. Auch ein Überschreiben vorhandener Kopien kann automatisch ohne Nachfrage erfolgen.
So sieht das Makro im Moment aus:

Sub speichern_unter()
Dim Pfad$, Datei$, Filter$, Endg$, File
Pfad = "C:\Kunden\"
Datei = ActiveSheet.Range("A5")
If Datei = "" Then
MsgBox "Zelle einhält keinen Eintrag"
Exit Sub
End If
Endg = ".xls"
If InStr(Datei, Endg) = 0 Then 'Prüfung ob Zelle bereits Endung enthält
Datei = Datei & Endg
End If
Filter = "Excel Files (*" & Endg & "), *" & Endg
File = Application.GetSaveAsFilename(Pfad & Datei, Filter)
If File <> False Then ActiveWorkbook.SaveAs Filename:=File
End 

Sub
Danke für eure Mühe!
Gruß
Max

		

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro (Save as) erweitern (erledigt)
26.05.2005 07:52:19
Max
Hallo,
durch Ausprobieren ("aus 2 mach 1")habe ich jetzt was ich brauche. Ich weiß zwar nicht
warum es funktioniert und vielleicht ist es auch keine besonders schöne Lösung aber es
klappt:

Sub speichern_unter()
Dim Pfad$, Datei$, Filter$, Endg$, File
Pfad = "C:\temp"
Datei = ActiveSheet.Range("A5")
If Datei = "" Then
MsgBox "Zelle einhält keinen Eintrag"
Exit Sub
End If
Endg = ".xls"
If InStr(Datei, Endg) = 0 Then 'Prüfung ob Zelle bereits Endung enthält
Datei = Datei & Endg
End If
Filter = "Excel Files (*" & Endg & "), *" & Endg
File = Application.GetSaveAsFilename(Pfad & Datei, Filter)
If File <> False Then ActiveWorkbook.SaveAs Filename:=File
Dim sFile As String, sPath As String, sEndg As String
sPath = "C:\Backup\"
sFile = Range("A5").Value & " (Kopie)"
sEndg = ".xls"
ActiveWorkbook.SaveAs sPath & sFile
End Sub

Gruß
Max
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige