PDF Olarak Kaydetme

[uurc1]

Sub kaydet()
Dim fno
fno = InputBox("Dosya Adını Giriniz", "")
If fno = False Or fno = "" Then
    MsgBox "islem iptal"
Else
    ActiveSheet.PageSetup.PrintArea = "A94:CB132"
    ActiveSheet.ExportAsFixedFormat xlTypePDF, CreateObject("wscript.Shell").Specialfolders.Item("Desktop") & "\" & fno & ".pdf"
    MsgBox "islem tamam"
End If
End Sub

Arkadaşlar dün biraz araştırdım ve yukarıda yazan kodu buldum bu kodda dosyayı masa üstüne kaydediyor ve dosya adını yazmamızı istiyor.
uğraşmama rağmen bir türlü dosya yı kayıt yerini değiştiremedim birde dosya adını günün tarihi ve CE94 hücresinde yazan isim olarak otamatik olarak versin istiyorum aynı tarih ve sisim ikinci kez olacaksa 1-2-3 diye devam etmeli yardımcı olabilirseniz sevinirim. şimdiden teşekkür ederim

 

[askm]

Kodları aşağıdaki şekilde değiştirdim.
Deneyin.
Sub kaydet()
Dim Yol As String
Yol = ThisWorkbook.Path 'Dosyanın olduğu klasör içine kaydeder.
Dim fno
fno = Date 'Dosya Adı
If fno = False Or fno = "" Then
MsgBox "islem iptal"
Else
ActiveSheet.PageSetup.PrintArea = "A94:CB132"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Yol & "\" & fno & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
Application.ScreenUpdating = True
Application.DisplayAlerts = True


MsgBox "islem tamam"
End If
End Sub

 

[Tevfik_Kursun]

Merhaba Arkadaşlar,
Sayın askm arkadaş cevap vermiş. Teşekkür ederiz. Benim örnek te alternatif olsun.
Hepimize kolay gelsin.

 

[uurc1]

Teşekkür ederim.

 

[sametozyavuz]

sıra numarası vermeyi başaramadım ama tarih ve hücre adı veriyor.

Sub Makro1()
ActiveSheet.PageSetup.PrintArea = "A94:CB132"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Users\TOHUMLUK1\Desktop\" & Format(Now, "dd.mm.yyyy") & "_" & Range("CE94").Value & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
        MsgBox "işlem tamamlandı"
End Sub

 

[uurc1]

sıra numarası vermeyi başaramadım ama tarih ve hücre adı veriyor.

Sub Makro1()
ActiveSheet.PageSetup.PrintArea = "A94:CB132"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Users\TOHUMLUK1\Desktop\" & Format(Now, "dd.mm.yyyy") & "_" & Range("CE94").Value & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
        MsgBox "işlem tamamlandı"
End Sub

Üstadım yazdığınız kodda tohumluk1 yazan yere kendi dosya adımı yazdım ancak hata veriyor.

 

[sametozyavuz]

bir de bunu deneyin

Sub saveasdosya()
Dim dosyam As String, evn As Object, i As Byte
Set evn = CreateObject("scripting.filesystemobject")
With Sheets("sayfa1")
dosyam = "C:\Users\TOHUMLUK1\Desktop\" & Format(Now, "dd.mm.yyyy") & "_" & Range("CE94").Value & ".pdf"
10 If evn.fileexists(dosyam) Then
i = i + 1
dosyam = "C:\Users\TOHUMLUK1\Desktop\" & Format(Now, "dd.mm.yyyy") & "_" & Range("CE94").Value & i & ".pdf"
GoTo 10
End If
End With
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=dosyam
MsgBox "Farklı kayıt işlemi bitmiştir", vbInformation, "Farklı Kaydet"
dosyam = vbNullString: Set evn = Nothing: i = Empty
End Sub

 

[sametozyavuz]

dosya yolunuzun tam ve doğru olduğunu kontrol etmeye çalışın.
olmadı sadece "C:\" veya "D:\" klasörlerini deneyin.

 

[uurc1]

bir de bunu deneyin

Sub saveasdosya()
Dim dosyam As String, evn As Object, i As Byte
Set evn = CreateObject("scripting.filesystemobject")
With Sheets("sayfa1")
dosyam = "C:\Users\TOHUMLUK1\Desktop\" & Format(Now, "dd.mm.yyyy") & "_" & Range("CE94").Value & ".pdf"
10 If evn.fileexists(dosyam) Then
i = i + 1
dosyam = "C:\Users\TOHUMLUK1\Desktop\" & Format(Now, "dd.mm.yyyy") & "_" & Range("CE94").Value & i & ".pdf"
GoTo 10
End If
End With
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=dosyam
MsgBox "Farklı kayıt işlemi bitmiştir", vbInformation, "Farklı Kaydet"
dosyam = vbNullString: Set evn = Nothing: i = Empty
End Sub

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=dosyam
bu satırda bir sıkıntı çıkıyor
düzeltemedim bir türlü

bu satırda dosyam yazan yeri ce94 de yazan veriyi kullanarak bir dosya adı yaza bileceğimi düşündüm ve dosyam yolunu ce94 dedim TOHUMLUK1 içinde ce94 de yazan isimle bir klasör çtı ancak içi boş hiçbir kayıt yoktu

 

[sametozyavuz]

farklı kaydetmek istediğiniz klasörün yolunu gönderirmisiniz.

 

[uurc1]

sametozyavuz arkadaşın yardımlarına rağmen istediğim gibi pdf olarak kaydetmeyi başaramadım.
Dosya kayıt yerinin benim gösterdiğim gibi C:\Users\Desktop\Hazırlananlar klasörü olması
ve dosya adını CE94 hücresinde yazan isim olarak otamatik olarak vermesini istiyorum
yardımlarınızı bekliyorum.

 

[Tevfik_Kursun]

Merhaba Arkadaş,
Sanırım eklediğim dosyayı hiç incelemediniz.
İyi çalışmalar

 

[vardar07]

Benzer bir konu inceleyiniz fikir verebilir.
http://www.excel.web.tr/f48/excel-vba-klasor-olu-turma-ve-farkly-kaydetme-t137362.html