AW: speichern unter
24.03.2011 15:48:11
Ralf_P
Hallo Peter,
lies mal das:
Geschrieben am: 08.09.2005 10:32:33
Hallo Experten,
ich möchte für den "Speichern unter - Dialog" einen fetsen Pfad vorgeben.
Private Sub Speichern()
Dim fn
fn = Application.GetSaveAsFilename("Testdatei", "Excel-Dateien (*.xls), *.xls")
If fn = False Then
MsgBox "Datei wurde nicht gespeichert!"
End If
End Sub
Nun möchte ich, den Speicherort bereits voreinstellen, da die Voreinstellung nicht passt.
Gruß Lutz
Hallo Lutz,
das funktioniert mit den Exceleigenen Dialogen nicht. Versuch es mal so:
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" ( _
pOpenfilename As OPENFILENAME) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, ByVal _
lpWindowName As String) As Long
Private 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
Private Const gcClassnameMSExcel = "XLMAIN"
Public Sub prcSaveAs()
Const strInitialFilename = "Testdatei"
Dim udtOFN As OPENFILENAME
Dim strFilename As String
With udtOFN
.lStructSize = Len(udtOFN)
.hwndOwner = FindWindow(gcClassnameMSExcel, Application.Caption)
.lpstrFilter = "Excelfiles (*.xls)" + Chr$(0) + "*.xls" + Chr$(0)
.lpstrFile = strInitialFilename & Space$(254 - Len(strInitialFilename))
.nMaxFile = 255
.lpstrFileTitle = Space$(254)
.nMaxFileTitle = 255
.lpstrInitialDir = "D:\Eigene Dateien\Eigene Tabellen\"
.lpstrTitle = "Save As"
.flags = 0
End With
If GetSaveFileName(udtOFN) Then
strFilename = Trim$(udtOFN.lpstrFile)
MsgBox strFilename 'nur zum testen
' ThisWorkbook.SaveAs strFilename
Else
MsgBox "Datei wurde nicht gespeichert!", 48, "Hinweis"
End If
End Sub
Gruß
Nepumuk
Excel & VBA Beispiele
VG, Ralf