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

speichern unter -Dialog

speichern unter -Dialog
06.09.2006 09:54:55
Andreas-WE
Hallo zusammen,
habe da ein kleines (für mich großes) Problem.
Ich habe mir da einen code zusammengeschraubt, der mir das aktuelle sheet und das sheet ‚Projektliste’ als eigene Datei kopiert, zusammen mit dem Modul ‚Funktionen’.
Die neue Datei wird hier automatisch unter dem gleichen Pfad gespeichert, wie die Quelldatei.
Das Makro steht in einem eigene Modul.
––––––––––––––––––––
Public Const C_Filename As String = "\duplicate_module.bas"
Public Const C_Module As String = "Funktionen"

Sub Taet_copy()
Dim strFile As String
strFile = Environ("TEMP") & C_Filename
Dim NFN
Dim NFP
Dim QDT
QDT = ThisWorkbook.Name
NFN = ActiveSheet.Name
NFP = ThisWorkbook.Path
Application.VBE.ActiveVBProject.VBComponents(C_Module).Export (strFile)
Workbooks.Add.VBProject.VBComponents.Import (strFile)
ActiveWorkbook.SaveAs Filename:=NFP & "\" & NFN, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ThisWorkbook.ActiveSheet.Copy Before:=Workbooks(NFN & ".xls").Sheets(1)
ThisWorkbook.Sheets("Projektliste").Copy Before:=Workbooks(NFN & ".xls").Sheets(2)
Application.DisplayAlerts = False
Sheets(Array("Tabelle1", "Tabelle2", "Tabelle3")).Delete
Application.DisplayAlerts = True
Sheets(NFN).Select
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows(QDT).Activate
End Sub

––––––––––––––––––––
Diese Makro möchte ich jetzt erweitern, so dass ich über den ‚speichern unter’-Dialog den Speicherort wählen kann und das am besten mit vorbelegtem Pfad.
Ähnlich wie:
Pfad = "C:TEMP\"
Application.Dialogs(xlDialogSaveAs).Show (Pfad)
Ich habe selbst schon rumprobiert, bekomme es aber einfach nicht hin. :-((
Könnt Ihr mir das bitte irgendwie mit reinbasteln? Wäre echt nett!
Gruß
Andreas-WE

16
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: speichern unter -Dialog
06.09.2006 10:14:59
PeterB
Hallo,
probiers mal mit der GetSaveAsFileName-Methode in der online-Hilfe
Gruss
PeterB
AW: speichern unter -Dialog
06.09.2006 10:26:40
Andreas-WE
Hallo Peter,
danke für Deine Antwort.
Habe versucht Deinen Tip selbst reinzubasteln, bekomme es aber nicht hin.
Bin halt kein wirklicher VBA-Freak.
Den bestehenden code habe ich mir aus anderen zusammengeschustert.
Vielleicht wärst Du so nett und könntest mir den Dialog kurz einbauen.
Das würde mir wirklich sehr sehr helfen.
Gruß
Andreas-WE
AW: speichern unter -Dialog
06.09.2006 11:00:27
PeterB
also gut, Andreas:
Nach dem Erzeugen des neuen Workbooks und vor dem bisherigen 'SaveAs' fügst du den folgenden Code zur Abfrage des Speicherortes ein (Variable as String deklarieren):
NewFullName = ""
NewFullName = Application.GetSaveAsFilename(NFN, _
fileFilter:="Microsoft Excel-Arbeitsmappe (*.xls)")
If NewFullName <> "" Then
ab hier alten code beginnend mit ActiveWorkbook.SaveAs einsetzen, wobei das
ehemalige 'NFP & "\" & NFN' durch NewFullName ersetzt wird.
Else
Überlegen, was hier kommen muß, wenn der Benutzer auf Abbrechen drückt
und kein String zurückgegeben wird. Evtl. erzeugtes Workbook schliessen ohne
zu speichern oder ???
End If
Gruß
PeterB
Anzeige
AW: speichern unter -Dialog
06.09.2006 12:40:02
Andreas-WE
Hallo Peter,
habe Deine Anweisung soweit befolgt,
bekomme aber einen Laufzeitfehler 1004:
'Die Methode 'GetSaveAsFilename' für das Objekt '_Application'ist fehlgeschlagen.
Dim NewFullName As String habe ich deklariert.
Gruß
Andreas
AW: speichern unter -Dialog
06.09.2006 13:33:52
PeterB
Hallo Andreas,
Du hast recht.
Ich hab' bei einer Anwendung nachgeschaut und so läuft es:
NewFullName = Application.GetSaveAsFilename(InitialFilename:="C:\Datei.xls", FileFilter:="Microsoft Excel-Arbeitsmappe (*.xls), (*.xls)", Title:="Titel")
(Achtung: obige Zeile ist fortlaufend. Oder du machst einen Umbruch mit _ rein).
Noch eine Änderung: deklariere den NewFullName nicht als string, sondern als Variant (also: as string weglassen.)
Die Abfage unterhalb des getsaveasfilename ist dann If NewFullName <> FALSE Then
es kommt nämlich false zurück, wenn abbrechen gedrückt wird.
Gruß
PeterB
Anzeige
AW: speichern unter -Dialog
06.09.2006 14:09:26
Andreas-WE
Hallo Peter,
leider bekomme ich immernoch einen Laufzeitfehler.
Ich denke, ich habe den code so geändert, wie Du geraten hast:
Option Explicit
Public Const C_Filename As String = "\duplicate_module.bas"
Public Const C_Module As String = "Funktionen"

Sub Taet_copy()
Dim strFile As String
strFile = Environ("TEMP") & C_Filename
Dim NFN
Dim NFP
Dim QDT
Dim NewFullName
QDT = ThisWorkbook.Name
NFN = ActiveSheet.Name
NFP = ThisWorkbook.Path
Application.VBE.ActiveVBProject.VBComponents(C_Module).Export (strFile)
Workbooks.Add.VBProject.VBComponents.Import (strFile)
NewFullName = ""
NewFullName = Application.GetSaveAsFilename(InitialFilename:="C:\Datei.xls", _
FileFilter:="Microsoft Excel-Arbeitsmappe (*.xls), (*.xls)", Title:="Titel")
If NewFullName <> False Then
ActiveWorkbook.SaveAs Filename:="D:\Dat\Zeiß\Test\" & Mid(NFN, 6, 2) & NewFullName, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ThisWorkbook.ActiveSheet.Copy Before:=Workbooks(NFN & ".xls").Sheets(1)
ThisWorkbook.Sheets("Projektliste").Copy Before:=Workbooks(NFN & ".xls").Sheets(2)
Application.DisplayAlerts = False
Sheets(Array("Tabelle1", "Tabelle2", "Tabelle3")).Delete
Application.DisplayAlerts = True
Sheets(NFN).Select
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows(QDT).Activate
Else
' ==> NOCH CHECKEN !!!
GoTo ENDE
End If
End Sub

Vielleicht könntest Du nochmal drüber schauen.
Gruß & Danke vorab
Andreas-WE
Anzeige
AW: speichern unter -Dialog
07.09.2006 07:00:11
Andreas-WE
noch offen
AW: speichern unter -Dialog
07.09.2006 09:10:33
PeterB
Hallo Andreas,
also Endspurt in Stichworten:
1 Goto Ende entfernen oder in Hochkomma setzen, solange Ende nicht existiert.
2 Übergebener Dateiname bei SaveAs ist ziemlicher Quark. NewFileName hat schon alles.
3 Wünsche an Pfad/Dateiname musst du in GetSaveAsFilename als InitialFilname übergeben.
4 Überleg dir, was ist, wenn der User einen anderen Pfad nimmt und einen anderen Namen.
5 Im weiteren Verlauf wird das Blätter kopieren nicht gehen, weil der Name der Zieldatei so nicht stimmen kann.
Gruß
Peter
AW: speichern unter -Dialog
07.09.2006 15:57:57
Andreas-WE
Hallo Peter,
zuerstmal danke für Deine Geduld.
Das was Du im Punkt 5 schreibst, ist genau der Knackpunkt und genau das, was ich eigentlich nicht möchte. Am wichtigsten ist für mich, dass bestimmte Arbeitsblätter zusammen mit einem bestimmten Modul kopiert werden, was ich auch schon gelöst habe. (Dank einiger guter Vorlagen und Recherche in Herber-Forum)
Das Zweitwichtigste, was ich gerne realisiert hätte, ist das mit dem Speicherort über Dialog, was aber scheinbar auf diesem Weg nicht möglich ist.
Ich möchte die Frage aber gerne noch offen lassen, vieleicht hat irgend jemand anderes noch ne kleine Idee, wie ich mein Tool diesbez. etwas anwenderfreundlicher machen könnte.
Dir aber trotzdem nochmal vielen Dank.
Gruß
Andreas
Anzeige
AW: speichern unter -Dialog
07.09.2006 16:19:17
PeterB
Hallo Andreas,
wenn du in deinem Macro den gewünschten Namen zusammengebaut hast, die der GetSaveAsFilename-Funktion übergeben hast und der user positiv (nicht nothing) reagiert hat, speichert du die Datei unter dem zurückigelieferten Namen ab.
Dann fragst du die Datei mittel ... .Name nach ihrem Namen und schon hast du die benötigte Zielangabe für das hineinkopieren.
Also, weiter probieren
Gruß
Peter
AW: speichern unter -Dialog
08.09.2006 07:15:43
Andreas-WE
Hallo Peter,
nachdem ich versucht habe Deine Hinweise zu deuten und umzusetzen, erscheint zwar der Dialog an gewünschter Stelle, eine Datei wird aber nicht erzeugt und im nächsten trace kommt dann auch gleich mein lieber Freund Laufzeitfehler.
Mit meinen begrenzten VAB-Kenntnissen tu ich mir noch etwas schwer den Fehler zu finden, so brauche ich noch ewig und soviel Zeit kann ich nicht mehr investieren. Bezweifle auch, dass ich von selbst darauf komme. :-(
Ich stelle nochmal meinen ursprünglichen code rein, in der Hoffnung, dass sich jemand erbarmt und mir vielleicht den Dialog reinbaut:
Option Explicit
Public Const C_Filename As String = "\duplicate_module.bas"
Public Const C_Module As String = "Funktionen"

Sub Taet_copy()
Dim strFile As String
strFile = Environ("TEMP") & C_Filename
Dim NFN
Dim NFP
Dim QDT
Dim fileSaveName
QDT = ThisWorkbook.Name
NFN = ActiveSheet.Name
NFP = ThisWorkbook.Path
Application.VBE.ActiveVBProject.VBComponents(C_Module).Export (strFile)
Workbooks.Add.VBProject.VBComponents.Import (strFile)
ActiveWorkbook.SaveAs Filename:=NFP & "\" & NFN, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ThisWorkbook.ActiveSheet.Copy Before:=Workbooks(NFN & ".xls").Sheets(1)
ThisWorkbook.Sheets("Projektliste").Copy Before:=Workbooks(NFN & ".xls").Sheets(2)
Application.DisplayAlerts = False
Sheets(Array("Tabelle1", "Tabelle2", "Tabelle3")).Delete
Application.DisplayAlerts = True
Sheets(NFN).Select
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows(QDT).Activate
MsgBox "Neu erstellte Datei muss noch verschoben werden"
End Sub

Danke & Gruß
Andreas
Anzeige
AW: speichern unter -Dialog
10.09.2006 18:01:06
schauan
Hallo Andreas,
warum stellst Du denn nicht den Entwicklungsstand Deines codes ein? Soll jetzt alles noch mal von vorn anfangen?
AW: speichern unter -Dialog
11.09.2006 07:56:44
Andreas-WE
Hallo schauan,
Der aktuelle Entwicklungsstand entspricht dem, den ich zuletzt reingestellt habe, plus einem Dialogaufruf, der nicht funktioniert. Dieser code funktioniert aber soweit. Hier müsste eigentlich nur noch der Speichern-Dialog reinbgebaut werden.
Wenn ich sehe, was so manche Profis in diesem Forum für geniale Sachen programmieren, müsste doch eigentlich irgend jemand diesen Dialog einbauen können. :-)
Andreas
AW: speichern unter -Dialog
11.09.2006 16:42:21
schauan
Hallo Andreas,
da kommt aber trotzdem nix gescheites bei raus. Überwache mal Deine Variablen und die zusammengesetzten Ausdrücke. Da ist aber vieles anders als am Anfang und da wolltest Du nur den Pfad wählen. Lösung kommt gleich.


If NewFullName <> False Then
'- eine Lösung für 1. -  Laufwerk abschneiden
  NewFullName = Right(NewFullName, Len(NewFullName) - 3)
'1. Im Name stört der Doppelpunkt und der Backslash. Wenn Du auf Speichern drückst hast Du C:\Datei.xls
'2. Dann bekommst Du einen selsanmen Namen in
  ActiveWorkbook.SaveAs Filename:="C:\Test\" & Mid(NFN, 6, 2) & NewFullName, _
   FileFormat:=xlNormal
' wird zu C:\Test\leDatei.xls
'  ActiveWorkbook.SaveAs Filename:="D:\Dat\Zeiß\Test\" & Mid(NFN, 6, 2) & NewFullName, _
'hier kopierst Du ein Blatt in eine Datei Tabelle1.xls - woher kommt die denn?
  ThisWorkbook.ActiveSheet.Copy Before:=Workbooks(NFN & ".xls").Sheets(1)
  ThisWorkbook.Sheets("Projektliste").Copy Before:=Workbooks(NFN & ".xls").Sheets(2)

     Code eingefügt mit Syntaxhighlighter 4.0

Anzeige
AW: @André
11.09.2006 17:00:14
schauan
Hallo Sepp,
ich gehöre leider noch zur werktätigen Bevölkerung und bekomme daher nicht alles mit :-(

306 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige