Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro, Blatt Speichern unter Pfad...

Makro, Blatt Speichern unter Pfad...
Christopher
Hallo,
ich versuche in unserer Produktionstabelle ein Makro zu erstellen, das folgende Dinge tun sollen. (Beispieldatei im Anhang) https://www.herber.de/bbs/user/70653.xlsm
Ich befinde mich in einem Arbeitsblatt "Chain" und erstelle dort einen Produktionsauftrag. Nachdem ich alle Daten eingegeben habe, soll durch clicken der Schaltfläche nur das eine Arbeitsblatt "Chain" als eine separate Datei unter einem bestimmten Namen an einer bestimmten Stelle abgespeichert werden.
Der Name ist festgelegt als der Inhalt einer bestimmten Zelle (im Bsp. "F22").
Soweit habe ich es geschafft, dass das "Speichern unter" Dialogfenster geöffnet wird, und der Dateiname aus der Zelle vorgeschlagen wird.
Jetzt muss ich nur noch hinbekommen, dass es nicht die gesamte Datei, sondern nur das eine Blatt "Chain" abspeichert, und mir dafür den Speicherort C:\Dokumente und Einstellungen\csc\Eigene Dateien\csc\Chain\ vorschlägt.
Später will ich das für alle Blätter so machen, mit verschiedenen Speicherorten...
im Voraus vielen Dank für Eure Hilfe!
Grüße,
Christopher

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
Einzelnes Tabellenblatt aus Datei speichern
20.07.2010 14:49:32
NoNet
Hallo Christopher,
teste es mal mit diesem Makro :
Sub DateiSpeichern()
Dim strPfad As String, strDateiname As String
Dim strAktuellerPfad As String
strPfad = Replace(Range("F22"), ":", "-") 'Doppelpunkt ersetzen
strAktuellerPfad = ActiveWorkbook.Path
If Len(strPfad) = 0 Then
MsgBox ("Ungültiger Dateiname: Die angegebene Zelle darf nicht leer sein!")
Else
ActiveSheet.Copy 'Kopiert nur das AKTUELLE Blatt in eine neue Datei !
'Application.Dialogs(xlDialogSaveAs).Show (ort & ".xlsm")
strDateiname = Application.Dialogs(xlDialogSaveAs).Show(strAktuellerPfad & "\" &  _
strPfad & ".xlsm")
If strDateiname  "" Then
ActiveWorkbook.SaveAs strDateiname
ActiveWorkbook.Close
ChDir strAktuellerPfad 'Verzeichnis wieder auf Ursprung wechseln
MsgBox "Datei gespeichert !"
End If
End If
End Sub
Den Doppelpunkt aus F22 muss man durch ein anderes Zeichen (hier: "-") ersetzen !
Gruß, NoNet
Anzeige
AW: Einzelnes Tabellenblatt aus Datei speichern
20.07.2010 15:26:41
Christopher
Hallo NoNet,
hmm, ich verstehe nicht wirklich, was jetzt passiert... Es speichert wohl das einzelne Blatt unter dem Dateinamen aus der gewünschten Zelle ab - das ist schon mal sehr gut! ;)
Es nimmt allerdings den Speicherort der Ursprungsdatei als Speicherort. Mir schwebt vor, dass die Datei unter einem definierten Pfad abgelegt wird.
Außerdem erstellt es aus irgendeinem Grund die Datei zwei mal: Einmal mit dem Dateinamen wie gewünscht, und dann noch einmal mit dem Dateinamen "Wahr" oder "Falsch".
Ich hoffe wir bekommen das in den Griff...
Danke schonmal soweit!
Grüße,
Christopher
Anzeige
AW: Einzelnes Tabellenblatt aus Datei speichern
21.07.2010 13:46:42
Christopher
Hallo,
Ich habe das Makro noch ein bisschen angepasst, funktioniert nun sehr gut - vielen Dank für die Hilfe!
Ein einziges (kleines) Problem gibt es noch, und zwar wenn die Datei nicht gespeichert wird (weil z.B. die schon bestehende Datei nicht überschrieben werden soll) und der Speichervorgang abgebrochen wird, dann gibt es eine Fehlermeldung "Debuggen", und die schon erstellte neue Datei bleibt geöffnet stehen (richtiger Weise nicht gespeichert). Das ist etwas unschön, aber man kann damit leben.
viele Grüße,
Christopher
Sub DateiSpeichern()
Dim strDateiname As String, strPfad_Dateiname As String
Dim strAktuellerPfad As String
Dim strNeuerPfad As String
Dim strBlattname As String
Dim strNeueDatei As String
Dim strAlteDatei As String
strNeuerPfad = "Q:\Temp"
strAlteDatei = ActiveWorkbook.Name
strDateiname = Replace(Range("F22"), ":", " -") 'Doppelpunkt ersetzen
strAktuellerPfad = ActiveWorkbook.Path
If Len(strDateiname) = 0 Then
MsgBox ("Ungültiger Dateiname: Die angegebene Zelle darf nicht leer sein!")
Else
ActiveSheet.Select 'aktuelles Blatt markieren
strBlattname = ActiveSheet.Name
ActiveSheet.Copy 'Kopiert nur das AKTUELLE Blatt in eine neue Datei !
ActiveSheet.Shapes("Schaltfläche 1").Delete 'Knopf löschen
ActiveSheet.Range("C26").Delete 'Datum löschen
ActiveSheet.Range("F22").Delete 'Code löschen
strPfad_Dateiname = strNeuerPfad & "\" & strDateiname & ".xls"
ActiveWorkbook.SaveAs strPfad_Dateiname
ActiveWorkbook.Close
ChDir strAktuellerPfad 'Verzeichnis wieder auf Ursprung wechseln
MsgBox "Datei gespeichert !"
End If
End Sub

Anzeige

87 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige