Speichern unter -Dialog

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

Sub Speichern() Dim fn Dim Pfad As Variant Pfad = "D:\Mein Ordner\" fn = Application.GetSaveAsFilename(Pfad & "Name", "Excel-Dateien (*.xls), *.xls") If fn = False Then MsgBox "Formular wurde nicht gespeichert!" 'Call Speichern End If ActiveWorkbook.SaveAs fn End Sub

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Speichern unter -Dialog

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread