Datei zum Speichern auswählen |
|
Möchte man aus einem Makro heraus eine Datei speichern und dem Benutzer dabei die Möglichkeit bieten, das Laufwerk, das Verzeichnis und den Dateinamen selber festzulegen, steht eigentlich nur eine Funktion zur Verfügung: Das Word-interne Dialogfeld Dialogs(wdDialogsFileSaveAs) (siehe wd-Konstanten der Dialogfelder). Dieses Dialogsfeld besitzt aber den Nachteil, dass nur vordefinierte Formattypen ausgewählt werden können.
Möchte man z.B. ein Dialogfenster ähnlich dem der VBAIDE zum Export eines Moduls oder einer Userform verwenden,
stösst man schnell auf das Problem, dass die entsprechenden Formattypen nicht angeboten werden. Public Declare Function GetSaveFileName Lib "comdlg32.dll" _ Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long Dieser auf den ersten Blick sehr einfache API-Aufruf verbirgt seine Möglichkeiten hinter der Parameter-Struktur OPENFILENAME:
Diese Struktur beinhaltet nicht nur Initialisierungsinformationen für das Dialogfenster, sondern liefert auch Informationen
über den angegebenen Dateinamen, Dateipfad und Verzeichnis zurück. Public Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type Das folgende Beispiel öffnet ein Dialogfenster zum Exportieren von VBA-Prozeduren (Userforms,Module oder Klassenmodule) mit dem angegebenen Titel. Über die festgelegten Filter werden nur diese Dateiendungen angeboten. Wichtig Function fkt_FileSaveAs(sModul, sType) As String Dim sFilters As String Dim intError As Integer ' Formattyp-Filter festlegen sFilters = "Formulardateien(*.frm)" & vbNullChar & "*.frm" & vbNullChar & _ "Basic-Dateien (*.bas)" & vbNullChar & "*.bas" & vbNullChar & _ "Klassendateien (*.cls)" & vbNullChar & "*.cls" & vbNullChar & _ "Alle Dateien" & vbNullChar & "*.*" & vbNullChar & vbNullChar With OFName 'Setzt die Größe der OPENFILENAME Struktur .lStructSize = Len(OFName) 'Der Window Handle ist bei VBA fast immer &O0 .hwndOwner = &O0 ' Formattyp-Filter setzen .lpstrFilter = sFilters ' Auswerten des Dateityps zur Auswahl des Filers Select Case sType Case ".frm" .nFilterIndex = 1 Case ".bas" .nFilterIndex = 2 Case ".cls" .nFilterIndex = 3 Case Else .nFilterIndex = 4 End Select ' Buffer für Dateinamen erzeugen .lpstrFile = sModul & Space$(1024) & vbNullChar & vbNullChar ' Maximale Anzahl der Dateinamen-Zeichen .nMaxFile = Len(.lpstrFile) ' Buffer für Titel erzeugen .lpstrFileTitle = Space$(254) ' Maximale Anzahl der Titel-Zeichen .nMaxFileTitle = 255 ' Anfangsverzeichnis vorgeben .lpstrInitialDir = "c:\temp" .lpstrDefExt = sType & vbNullChar & vbNullChar ' Titel des Dialogfester festlegen .lpstrTitle = "Modul exportieren" ' Flags zum Festlegen eines bestimmten Verhaltens, ' OFN_LONGNAMES = lange Dateinamen verwenden ' OFN_OVERWRITEPROMPT = Abfrage vorm Überschreiben .flags = OFN_LONGNAMES Or OFN_OVERWRITEPROMPT End With ' API aufrufen und evtl. Fehler abfangen intError = GetSaveFileName(OFName) If intError <> 0 Then fkt_FileSaveAs = Left(OFName.lpstrFile, InStr(1, OFName.lpstrFile, Chr(0)) -1) ElseIf intError = 0 Then ' Abbruch durch Benutzer oder Fehler End If End Function |
Besucher: 0 online | 0 heute | 0 diesen Monat | 2202273 insgesamt | Seitenaufrufe: 56 | Letzte Änderung: 24.06.2006 | © 2001-18 Christian Freßdorf | ||||
Die Geschichte wiederholt sich nicht, wohl aber die Leichtfertigkeit, mit der sie gemacht wird. W. Weidner |
powered by phpCMS and PAX |