Klasörlere gözat

[kartalkartal]

Merhaba Arkadaşlar,

Aşağıdaki koda ekteki resimdeki klasörlere gözat seçtiğin klasöre kaydet nasıl yapabiliriz.

Sub farklı_kaytet_pdf()
ActiveSheet.PageSetup.PrintArea = "$a$1:$t$" & Range("A65536").End(3).Row
Set ac = Application.FileDialog(msoFileDialogSaveAs)

yol = ThisWorkbook.Path
isim = Cells(1, "u").Value
dosya_adı = Cells(1, "u").Value
If dosya_adı = "" Then
MsgBox "Dosya adı yok"
Exit Sub
End If
a = MsgBox(" Kayıt etmek istiyormusunuz.?", vbYesNo + vbInformation, " Uyarı")
If a = vbYes Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & dosya_adı, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ActiveWorkbook.Save

MsgBox isim & " ismiyle" & vbCrLf _
& yol & " dosya yoluna kaydedilmiştir."
End If
If a = vbNo Then
MsgBox "işlemi iptal ettiniz.!"
End If
End Sub

 

[ÖmerBey]

Tam istediğiniz gibi değil ama işinizi görür.

Sub farklı_kaytet_pdf()
ActiveSheet.PageSetup.PrintArea = "$a$1:$t$" & Range("A65536").End(3).Row
Set ac = Application.FileDialog(msoFileDialogSaveAs)

isim = Cells(1, "u").Value
dosya_adı = Cells(1, "u").Value
If dosya_adı = "" Then
MsgBox "Dosya adı yok"
Exit Sub
End If
a = MsgBox(" Kayıt etmek istiyormusunuz.?", vbYesNo + vbInformation, " Uyarı")
If a = vbYes Then
[COLOR="red"]Application.FileDialog(msoFileDialogFolderPicker).Show
DosyaYolu = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)[/COLOR]
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
[COLOR="red"]DosyaYolu[/COLOR] & "\" & dosya_adı, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ActiveWorkbook.Save

MsgBox isim & " ismiyle" & vbCrLf _
& [COLOR="Red"]DosyaYolu[/COLOR] & " dosya yoluna kaydedilmiştir."
End If
If a = vbNo Then
MsgBox "işlemi iptal ettiniz.!"
End If
End Sub

 

[kartalkartal]

Merhaba,
Teşekkür ederim,aslında tam istediğim gibi.

İyi çalışmalar,kolay gelsin.