Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 14:03:38
Http-Request (POST) für GraphQL API-Abfrage
20.04.2024 08:56:18
Textbox in Tabellenblatt ohne Bestätigung in Zelle eintragen
20.04.2024 07:57:54
Tablle fürs E-Auto - Preis wenn kürzer als 60 Min Ladezeit
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
672to676
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
672to676
672to676
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Aufruf von Speichern unter

Aufruf von Speichern unter
03.10.2005 12:28:34
Speichern
Hallo,
kann ich mit VBA programmieren, dass beim Start des Programmes automatisch das Dialogfeld von Datei - Speichern unter aufgerufen wird, dass ich also das Standarddialogfeld von Windows zum Speichern von Dateien unter einem anderen Namen und Verzeichnis bekomme?
gruss volleybaerchen

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Aufruf von Speichern unter
03.10.2005 12:31:49
Speichern
Hallo VB,

Application.Dialogs(xlDialogSaveAs).Show

Gruß Matthias
AW: Aufruf von Speichern unter
03.10.2005 12:34:10
Speichern
Hallo Matthias,
vielen Dank! Das ging ja super schnell!
gruss volleybaerchen
AW: Aufruf von Speichern unter
03.10.2005 12:58:28
Speichern
Hallo Matthias,
kannst du mir noch sagen, wo ich etwas darüber nachlesen kann, damit ich weiss, wie ich gewisse Default-Werte vorgeben kann (für das Verzeichnis und für den neuen Dateinamen).
gruss volleybaerchen
AW: Aufruf von Speichern unter
03.10.2005 13:15:20
Speichern
Hi,
frag mal den Assistenten nach "Listen der integrierten Dialogfeldargumente"
Gruß
Nepumuk
Anzeige
AW: Aufruf von Speichern unter
03.10.2005 13:48:59
Speichern
Hallo Nepumuk,
leider hilft mir das bei meinen geringen Kenntnissen nicht viel weiter. Ich sehe dort zwar einige Argumente bei xlDialogSaveAs, aber ich kann nichts damit anfangen.
Was muss ich machen, wenn ich statt des bisherigen Dateinamens nun den Namen "neu" oder ein leeres Feld als Vorgabe anzeigen möchte?
gruss volleybaerchen
AW: Aufruf von Speichern unter
03.10.2005 14:18:04
Speichern
Hi,
document_text = Vorgabename + Pfad
type_num = Dateityp (kannst du bei normalen mappen leer lasse)
prot_pwd = Schreib- Lesekennwort
backup = erstellt eine Backupdatei
write_res_pwd = Schreibschutzkennwort
read_only_rec = Schreibschutzempfehlung beim öffnen
Beispiel:
Application.Dialogs(xlDialogSaveAs).Show "C:\Testmappe", , "test", "False", "", "False"
Vorgabename + Pfad = "C:\Testmappe"
Dateityp = LEER ~ normale Excelmappe
Kennwort = "test"
Backup = False ~ keine Backupdatei erstellen
Schreibschutzkennwort = "" ~ kein Kennwort
Schreibschutzempfehlung = False ~ keine Schreibschutzempfehlung
Jetzt klarer?
Gruß
Nepumuk
Anzeige
AW: Aufruf von Speichern unter
03.10.2005 16:56:11
Speichern
Hallo Nepumuk,
vielen Dank für die sehr gute Erklärung. Ich wusste nicht, dass man das direkt dahinter schreiben kann. Kann ich diese Werte auch abfragen (Falls der Dateiname mit dem Original übereinstimmt, soll nicht gespeichert werden)?
gruss volleybaerchen
AW: Aufruf von Speichern unter
03.10.2005 17:16:01
Speichern
Hi,
mit diesem Dialog nicht. Versuch es mal damit:
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

Public Const OFN_SHAREWARN = 0
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHAREFALLTHROUGH = 2

Public Const OFN_READONLY = &H1
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_SHOWHELP = &H10
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOLONGNAMES = &H40000
Public Const OFN_EXPLORER = &H80000
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_LONGNAMES = &H200000

Private Const gcClassnameMSExcel = "XLMAIN"

Public Sub prcSaveAs()
    Const strInitialFilename = "Testdatei"
    Dim udtOFN As OPENFILENAME
    Dim strFilename As String
    Do
        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 = OFN_SHAREWARN
        End With
        If GetSaveFileName(udtOFN) Then
            strFilename = Trim$(udtOFN.lpstrFile)
            strFilename = Left$(strFilename, Len(strFilename) - 1)
            If strFilename <> ThisWorkbook.FullName Then
                ThisWorkbook.SaveAs strFilename
                Exit Do
            Else
                MsgBox "Die Datei darf nicht überschieben werden.", 48, "Hinweis"
            End If
        Else
            Exit Do
        End If
    Loop
End Sub
Gruß
Nepumuk
Anzeige
AW: Aufruf von Speichern unter
03.10.2005 17:23:35
Speichern
Hallo Nepumuk,
ich werde diesen Quellcode einmal ausprobieren! Vielen Dank für die Mühe, die du dir an diesem Feiertag gemacht hast
gruss volleybaerchen
AW: Aufruf von Speichern unter
04.10.2005 06:40:52
Speichern
Hallo Nepumuk,
bei deinem Code, den ich in ein Modul kopiert habe, habe ich noch zwei Probleme:
1. Wenn ich einen schon existierenden Namen eingebe und die anschliessende Abfrage, ob die bestehende Datei überschrieben werden soll, mit nein beantworte, bekomme ich immer die Fehlermeldung:
Laufzeitfehler 1004 - die Methode 'SaveAs' für das Objekt '_Workbook' ist fehlgeschlagen.
2. Wie kann ich das Eingabefenster direkt überprüfen? In strFilename steht nämlich immer auch der Pfad mit dabei, was ich nicht brauche. Ich möchte nämlich prüfen und verhindern, dass der Benutzer dort "Original" oder "original" oder "Original.xls" oder "original.xls"
oder etwas mit mehreren Grossbuchstaben wie z. B. "OrigiNal.XLs" eingeben kann.
gruss volleybaerchen
Anzeige
AW: Aufruf von Speichern unter
04.10.2005 10:00:55
Speichern
Hi,
neuer Versuch:
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

Public Const OFN_SHAREWARN = 0
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHAREFALLTHROUGH = 2

Public Const OFN_READONLY = &H1
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_SHOWHELP = &H10
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOLONGNAMES = &H40000
Public Const OFN_EXPLORER = &H80000
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_LONGNAMES = &H200000

Private Const gcClassnameMSExcel = "XLMAIN"

Public Sub prcSaveAs()
    Const strInitialFilename = "Testdatei.xls"
    Dim udtOFN As OPENFILENAME
    Dim strFilename As String
    Do
        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 = "C:\"
            .lpstrTitle = "Save As"
            .flags = OFN_SHAREWARN
        End With
        If GetSaveFileName(udtOFN) Then
            strFilename = Trim$(udtOFN.lpstrFile)
            strFilename = Left$(strFilename, Len(strFilename) - 1)
            If Right$(strFilename, 4) <> ".xls" Then strFilename = strFilename & ".xls"
            If LCase$(strFilename) <> LCase$(ThisWorkbook.FullName) Then
                On Error Resume Next
                ThisWorkbook.SaveAs strFilename
                If Err.Number = 0 Then Exit Do
                On Error GoTo 0
            Else
                MsgBox "Die Datei darf nicht überschieben werden.", 48, "Hinweis"
            End If
        Else
            Exit Do
        End If
    Loop
End Sub
Gruß
Nepumuk
Anzeige
AW: Aufruf von Speichern unter
04.10.2005 10:37:49
Speichern
Hallo Nepumuk,
ich habe alles gerade ausprobiert - es funktioniert nun wie gewünscht!!! vielen Dank für die Mühe. Kannst du mir noch mitteilen, wie ich den Abbrechen-Button deaktivieren kann (oder ihn so belegen kann, dass die komplette Datei geschlossen wird)? Sonst kann jemand, der am Anfang die Originaldatei nicht unter einem neuen Namen speichert, beim Beenden des Programms doch noch die Originalversion überschreiben.
gruss volleybaerchen
AW: Aufruf von Speichern unter
04.10.2005 10:51:37
Speichern
Hi,
diesen Button kann ich nicht deaktivieren, aber der User kann gezwungen werden zu speichern:
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

Public Const OFN_SHAREWARN = 0
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHAREFALLTHROUGH = 2

Public Const OFN_READONLY = &H1
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_SHOWHELP = &H10
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOLONGNAMES = &H40000
Public Const OFN_EXPLORER = &H80000
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_LONGNAMES = &H200000

Private Const gcClassnameMSExcel = "XLMAIN"

Public Sub prcSaveAs()
    Const strInitialFilename = "Testdatei.xls"
    Dim udtOFN As OPENFILENAME
    Dim strFilename As String
    Do
        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 = "C:\"
            .lpstrTitle = "Save As"
            .flags = OFN_SHAREWARN
        End With
        If GetSaveFileName(udtOFN) Then
            strFilename = Trim$(udtOFN.lpstrFile)
            strFilename = Left$(strFilename, Len(strFilename) - 1)
            If Right$(strFilename, 4) <> ".xls" Then strFilename = strFilename & ".xls"
            If LCase$(strFilename) <> LCase$(ThisWorkbook.FullName) Then
                On Error Resume Next
                ThisWorkbook.SaveAs strFilename
                If Err.Number = 0 Then Exit Do
                On Error GoTo 0
            Else
                MsgBox "Die Datei darf nicht überschieben werden.", 48, "Hinweis"
            End If
        Else
            MsgBox "Sie müssen speichern.", 48, "Hinweis"
        End If
    Loop
End Sub
Gruß
Nepumuk
Anzeige
AW: Aufruf von Speichern unter
04.10.2005 12:23:02
Speichern
Hallo Nepumuk,
vielen Dank für die Viele Mühe, die du dir mit meinen Problemen gemacht hast! Nun komme ich hoffentlich wieder alleine weiter.
gruss volleybaerchen

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige