mevcut olan "sayfaları ayır ve (excell olarak) kaydet" makrosuna PDF Eklemek

[ermanusta]

arkadaşlar elimde bu şekilde çalışan bir makrom var
bu makro kitap içindeki sayfaları tek klasör içine ayrı ayrı kitap halinde kaydediyor.

yapmak istediğim şey ise; excell formatında değil de PDF formatında kaydedebilir mi ?
Yazıcılarımda PDF converter yüklü
(dosya uzantısını değiştirince formatı okumuyor, xlsx uzantılı dosyayı .pdf uzantıya çevirip açmaya çalışmak gibi oluyor, yani en sonki uzantıyı değiştirmek işe yaramıyor.

Makro:


Sub sayfalari_ayir_kaydet()
Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
MyFilePath$ = ActiveWorkbook.Path & "\" & _
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
On Error Resume Next
MkDir MyFilePath
For N = 1 To Sheets.Count
Sheets(N).Activate
SheetName = ActiveSheet.Name
Cells.Copy
Workbooks.Add (xlWBATWorksheet)
With ActiveWorkbook
With .ActiveSheet
.Paste
.Name = SheetName
[A1].Select
End With

.SaveAs Filename:=MyFilePath _
& "\" & SheetName & ".xlsx"
.Close SaveChanges:=True
End With
.CutCopyMode = False
Next
End With
Sayfa1.Activate
End Sub

 

[ÖmerBey]

Merhaba, aşağıdaki kodu kullanabilirsiniz.

    With ActiveSheet
        .ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=MyFilePath & "\" & SheetName & ".pdf", _
        OpenAfterPublish:=False
    End With

 

[ermanusta]

sondan 4.satırdaki "Next" döngüsünden hata alıyorum

 

[ermanusta]

sorunu çözebilmiş değilim, konu günceldir

 

[Haluk]

Merhaba;

Kullandığınız XL versiyonu ÖmerBey tarafından önerilen metodu desteklemiyor sanırım. Ancak; anladığıma göre bilgisayarınızda sanal PDF sürücüsü var.

O zaman, kodlarınızdaki Next satırından önce aşağıdaki kodu yerleştirip bir deneme yapabilirsiniz. Koddaki yazıcı ismini (Adobe PDF on Ne04:) kendi sisteminize göre değiştirmeyi unutmayın.

Application.ActivePrinter = "Adobe PDF on Ne04:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:="Adobe PDF on Ne04:", collate:=True

.

 

[ermanusta]

Merhaba;

Kullandığınız XL versiyonu ÖmerBey tarafından önerilen metodu desteklemiyor sanırım. Ancak; anladığıma göre bilgisayarınızda sanal PDF sürücüsü var.

O zaman, kodlarınızdaki Next satırından önce aşağıdaki kodu yerleştirip bir deneme yapabilirsiniz. Koddaki yazıcı ismini (Adobe PDF on Ne04:) kendi sisteminize göre değiştirmeyi unutmayın.

Application.ActivePrinter = "Adobe PDF on Ne04:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:="Adobe PDF on Ne04:", collate:=True

.

Cevabınız için teşekkür ederim.
başaralı olmadı, yazıcı yönteminde sanal PDF sürücüsü her seferinde onay istiyor. bu bir sorun oluşturdu.
farklı kaydet ile PDF formatında kaydedebilirmiyiz acaba, sayfanın adıyla kaydetmem gerekiyor
Kitap1 adıyla bir dosya ekledim basit ve içinde makrosu bulunan

 

[Haluk]

Erman Bey;
Dosyanizi manuel olarak farkli kaydet yapmayi denerken PDF secenegi cikmiyorsa VBA ile de yapamazsiniz. Bu tamamen sizin XL versiyonunuzla ilgili bir durum.
Sanal PDF yazici da isteklerinizi karsilamiyorsa ve bu tip PDF islerini sikca yapiyorsaniz, belki biraz butce ayirip XL versiyonunuzu yukseltmenin zamani gelmistir.
Kolay gelsin,

.

 

[ermanusta]

farklı kaydet penceresinde PDF seçeneği var, hatta yazıcılarda da "convert to PDF" var, fakat makroyu çalıştıramadım.
kitap içinde 200 den fazla sayfa mevcut ve bunları el ile yapmamın imkanı yok.
daha önce excell olarak kaydettim tüm sayfaları tek tek.
fakat şimdi PDF yapmam gerekiyor.

 

[Haluk]

farklı kaydet penceresinde PDF seçeneği var.....

O zaman aşağıdaki kodu deneyin, gerekirse ihtiyacınıza göre revize edersiniz.

Sub Sayfalari_Ayir_PDF_Kaydet()
    Dim objFSO As Object, FileName As String, MyFolder As String, N As Integer
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    FileName = objFSO.GetBasename(ThisWorkbook.Name)
    MyFolder = ThisWorkbook.Path & Application.PathSeparator & FileName
    If Dir(MyFolder, vbDirectory) = "" Then MkDir MyFolder
    For N = 1 To Worksheets.Count
        Worksheets(N).ExportAsFixedFormat Type:=xlTypePDF, FileName:=MyFolder & Application.PathSeparator & Sheets(N).Name
    Next
    Sheets(1).Activate
End Sub

.

 

[ermanusta]

1 sayfayı pdf yaptıktan sonra visual basic 400 hatasını alıyorum

 

[Haluk]

2010 versiyonu ile yaptığım denemelerde bir sorun olmadı. Dosyanızı bana e-posta ile gönderin, bakayım ......

.

 

[ermanusta]

2010 versiyonu ile yaptığım denemelerde bir sorun olmadı. Dosyanızı bana e-posta ile gönderin, bakayım ......

.

sanırım çıkan hata yazdırma alanı olmayan sayfalar içindi. şu an örnek dosyada çalışıyor.
ana dosyada deneyeceğim birazdan, durumu size bildireceğim.

 

[ermanusta]

Haluk bey gayet iyi çalıştı,
elinize sağlık, teşekkür ederim.

 

[Haluk]

Kolay gelsin ...


.

 

[bay_musti]

Haluk Bey ben de ilave birşey sorabilir miyim. beceremedim bir türlü.
her sayfayı sayfa adıyla değil de örneğin sayfalardaki a1 hücresindeki veri ile kaydetmesini istesem nasıl revize etmem gerekir ?

 

[bay_musti]

O zaman aşağıdaki kodu deneyin, gerekirse ihtiyacınıza göre revize edersiniz.

Sub Sayfalari_Ayir_PDF_Kaydet()
    Dim objFSO As Object, FileName As String, MyFolder As String, N As Integer
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    FileName = objFSO.GetBasename(ThisWorkbook.Name)
    MyFolder = ThisWorkbook.Path & Application.PathSeparator & FileName
    If Dir(MyFolder, vbDirectory) = "" Then MkDir MyFolder
    For N = 1 To Worksheets.Count
        Worksheets(N).ExportAsFixedFormat Type:=xlTypePDF, FileName:=MyFolder & Application.PathSeparator & Sheets(N).Name
    Next
    Sheets(1).Activate
End Sub

.

Yukarıdaki kodu revize edemedim rica etsem yardımcı olur musunuz
sayfaları kendi adıyla değil de içindeki bir hücrenin içeriği ile kaydetmesini istiyorum
"örneğin her sayfanın a1 hücresinde yazan veri ile kaydetmesi"

 

[Haluk]

bay-musti;

Aşağıdaki satırı eskisi ile değiştirin ...

Worksheets(N).ExportAsFixedFormat Type:=xlTypePDF, FileName:=MyFolder & Application.PathSeparator & Worksheets(N).Range("A1")

.