File-Name und File-Pfad

Sub WUExAbspeichen() ChDir "\\Phserver\Austausch\Für-Braun-WeKell" ActiveWorkbook.SaveAs FileName:="\\Phserver\Austausch\Für-Braun-WeKell\Test-WU-123.xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommend:=False, CreateBackup:=False ActiveWindows.Close End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Werner,
ist halb so wild wie es aussieht. Das Makro das du ansprechen musst heißt "Speichern_unter"


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
Dim OFName As OPENFILENAME, sPath As String
Public Sub Speichern_unter()
Dim sFile As String
sPath = "\\Phserver\Austausch\Für-Braun-WeKell\"
sFile = ShowSave
On Error Resume Next
If sFile <> "" Then ThisWorkbook.SaveAs sFile & ".xls"
End Sub
Private Function ShowSave() As String
OFName.lStructSize = Len(OFName)
OFName.hwndOwner = FindWindow("xlMain", vbNullString)
OFName.lpstrFilter = "Excel Files (*.xls)" + Chr$(0) + "*.xls"
OFName.lpstrFile = Space$(254)
OFName.nMaxFile = 255
OFName.lpstrFileTitle = Space$(254)
OFName.nMaxFileTitle = 255
OFName.lpstrInitialDir = sPath
OFName.lpstrTitle = "Speichern"
OFName.flags = 0
If GetSaveFileName(OFName) Then
ShowSave = Trim(OFName.lpstrFile)
Else
ShowSave = ""
End If
End Function

Code eingefügt mit: Excel Code Jeanie
Gruß
Nepumuk

hi Werner
vergiss das erste kleine macro!
ich habe ein viel besseres das funtioniert
sorry habe vergessen im vorigen macro
Dim Name As String'zu schreiben
Sub SpeichernUnter()
    Dim NewWorkbook As Object
    Dim strSaveName As String, strFileSaveName As String
    Set NewWorkbook = Workbooks.Add
    'Speicher-Unter-Dialog wird angezeigt und der eingestellte
    'Pfad inkl. Dateiname in die Variable
    strFileSaveName = Application.GetSaveAsFilename("Kopie.xls", _
        "Microsoft Excel-Arbeitsmappe (*.xls), *.xls")
    'Wird der Dialog mit "Abbrechen" geschlossen, wird die
    'neue Arbeitsmappe ohne Speichern geschlossen.
    If FileSaveName = False Then
        NewWorkbook.Close savechanges:=False
        Exit Sub
    End If
    'Die Datei wird gespeichert.
    NewWorkbook.SaveAs (strFileSaveName)
    'Der Name der Datei wird aus dem Speicherpfad ausgelesen.
    strSpeichername = NewWorkbook.Name
    ThisWorkbook.Activate
    'Bereich wird kopiert.
    Worksheets(2).Range("A1:A10").Copy
    'Neue Arbeitsmappe wird aktiviert.
    Workbooks(strSpeichername).Activate
    With ActiveWorkbook
        '"Tabelle2" wird aktiviert.
        .Worksheets(2).Activate
        'Zielbereich auswählen
        .Worksheets(2).Range("A1:A10").Select
        'Inhalt der Zwischenablage einfügen
        Selection.PasteSpecial Paste:=xlValues
        'Mappe schließen, Änderungen werden gespeichert.
        .Close savechanges:=True
    End With
    'Objektvariable wird geleert.
    Set NewWorkbook = Nothing
End Sub
gruss
ivan

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

126 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

File-Name und File-Pfad

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

126 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread