Son kullanıcının exceli makrolu olarak kaydetmesi için gerekli kod nedir?

[egeyzb]

Aşağıda bulunan gibi bir kod kullanıyordum fakat bunu dosya ismini tarihli olarak değil Save as ekranında son kullanıcı tarafından girilebilecek bir kod olması gerekiyor. Birkça yöntem denedim fakat malesef başramadım.

Kısacası bu makroyu bir butona atadım ve bu butona basıldığında save as ekranı açılacak ve sadece dosya adını yazacak ve kaydetmek istediği yeri seçecek ve kaydet tuşuna basacak. formatı ile ilgili oynama yapamayacak kaydolan dosyaların hepsi xlsm olarak olması gerekiyor.

Yardımcı olursanız sevinirim.

Teşekkürler.

Sub save_file()
Dim tDate As String
Dim FileSaveName As String
Dim fPath As String
tDate = VBA.Format(DateSerial(Year(Date), Month(Date), Day(Date)), "dd-mm-yyyy")
'FileSaveName = Application.GetSaveAsFilename(InitialFileName:=tDate, filefilter:="Excel Files(*.xlsm),*.xlsm", Title:="Please save the file")
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
If .SelectedItems.Count <> 0 Then
fPath = .SelectedItems(1) & "\"
ActiveWorkbook.SaveAs fPath & tDate & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
End If
End With
End Sub

 

[Muzaffer Ali]

Merhaba.
Kodlarda bir sorun yok. Makro içerebilen (.xlsm) dosya şeklinde kayıt oluyor.

 

[egeyzb]

evet sorunsuz çalışıyor fakat değiştirmek istediğim şeyi açıklayamamışım demekki.

Bu şuanki kod fakat bunda değişiklik yapmak istiyorum tarihle kaydetmesin save as ekranı açılsın kullanıcı kendi isteğini yazsın istiyorum.

 

[Muzaffer Ali]

Buyurun

Sub save_file()
    Dim tDate As String
    Dim FileSaveName As String
    Dim fPath As String
    tDate = VBA.Format(DateSerial(Year(Date), Month(Date), Day(Date)), "dd-mm-yyyy")
    With Application.FileDialog(msoFileDialogSaveAs)
        .AllowMultiSelect = False
        .FilterIndex = 2
        .Show
        If .SelectedItems.Count <> 0 Then
            fPath = .SelectedItems(1)
            ActiveWorkbook.SaveAs fPath, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        End If
    End With
End Sub