Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1428to1432
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
Inhaltsverzeichnis

VBA Excel speichern unter Auswahlmöglichkeit?

VBA Excel speichern unter Auswahlmöglichkeit?
17.06.2015 13:04:38
Michael
Hall Forum,
mit folgendem Code erstelle ich mir eine neue Arbeitsmappe und speichere diese ab:
Workbooks.Add
ActiveWorkbook.SaveAs ("C:\Users\Michael\Desktop\test._" & _
Format(Day(Date), "00") & Format(Month(Date), "00") & Year(Date) & _
".xlsx")
besteht die Möglichkeit diese Formel in der Hinsicht anzupassen, dass vor dem speichern gefragt wird wo genau die Datei abgespeichert werden soll. Ich will ungern vorab einen festen Pfad angeben sondern jedes mal die Möglichkeit haben mir einen Pfad auszuwählen?
Gruß
Michael

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

Betreff
Datum
Anwender
Anzeige
AW: VBA Excel speichern unter Auswahlmöglichkeit?
17.06.2015 13:15:50
Hajo_Zi
Ordner Auswahl.
Option Explicit
' von Nepumuk
Private Type InfoT
hwnd As Long
Root As Long
DisplayName As Long
Title As Long
Flags As Long
FName As Long
lParm As Long
Image As Long
End Type
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As InfoT) As Long
Private Declare Function CoTaskMemFree Lib "ole32" (ByVal hMem As Long) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpStr1 As String, ByVal  _
lpStr2 As String) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pList As Long, ByVal lpBuffer  _
As String) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassname As  _
String, ByVal lpWindowName As String) As Long
Function GetAOrdner1() As String
Dim xl As InfoT, IDList As Long, RVal As Long, FolderName As String
With xl
.hwnd = FindWindow("xlmain", vbNullString)
.Title = lstrcat("Bitte wählen Sie ein Verzeichnis für die Ablage der HTM-Datei", "")
.Flags = 1
End With
IDList = SHBrowseForFolder(xl)
If IDList  0 Then
FolderName = Space(256)
RVal = SHGetPathFromIDList(IDList, FolderName)
CoTaskMemFree (IDList)
FolderName = Trim(FolderName)
FolderName = Left(FolderName, Len(FolderName) - 1)
End If
If Right(FolderName, 1)  "\" And Len(FolderName) > 0 Then FolderName = FolderName & "\"
GetAOrdner1 = FolderName
End Function
Function GetAOrdner2() As String
' nicht notwendig da XLA nich ab 2007
'    If BoFehler Then On Error GoTo Errorhandler1
'    With Application.FileDialog(msoFileDialogFolderPicker)
'        If .Show = -1 Then
'            GetAOrdner2 = .SelectedItems(1) & "\"
'        Else
'            GetAOrdner2 = ""
'        End If
'    End With
'    Exit Function
'Errorhandler1:
'    Fehlerbehandlung 1, 167
End Function
Sub Start123()
Dim StOrdner12 As String
StOrdner12 = GetAOrdner1
End Sub
Auch für vor 2007.
ab 2007
Option Explicit                                     ' Variablendefinition erforderlich
Option Private Module                               ' Keine Anzeige in Makroliste
Option Compare Text                                 ' keine Unterscheidung Groß-  _
Kleinbuchstaben
'* H. Ziplies                                     *
'* 14.11.13                                       *
'* erstellt von HajoZiplies@WEB.de                *
'* http://Hajo-Excel.de
Function GetAOrdner1() As String
If BoFehler Then On Error GoTo Errorhandler1
MsgBox "Es ist nicht vorgesehen das Sie eine XLAM Datei in einer Excel Version vor 2007  _
benutzen!!!" & Chr(13) & 70
Exit Function
Errorhandler1:
Fehlerbehandlung 1, 168
End Function
Function GetAOrdner2() As String
If BoFehler Then On Error GoTo Errorhandler1
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then
GetAOrdner2 = .SelectedItems(1) & "\"
Else
GetAOrdner2 = ""
End If
End With
Exit Function
Errorhandler1:
Fehlerbehandlung 1, 167
End Function
Sub Start123()
Dim StOrdner12 As String
StOrdner12 = GetAOrdner2
End Sub

Anzeige
AW: VBA Excel speichern unter Auswahlmöglichkeit?
17.06.2015 13:46:31
Michael
Danke Hajo

328 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige