Sekmelerin PDF çıktılarını almak

[bkr-ylmz]

Selamlar,

Ekteki örnek excel gibi bir dosyam bulunmakta, dosyadaki sekmelerin isimleri C sutünundaki isimlerle ayrı ayrı PDF çıktıları almam gerekiyor. Sekme sayısı az olunca sorun değil ama 20 ye yakın sekme oluşunca baya zaman alan bir işlem oluyor.
Bu işlemi makro ile yapmanın bir yolu var mıdır.

 

[anemis]

Elimde hazır olan, kendi projelerimden birince kullandığım ve (hiç kod bilgim olmadığından) direk alıp kullandığım bir kod var. Bende işe yarıyor. Aşağıdadır..

Private Sub CommandButton1_Click()

'Worksheets(ListBox1.Value).PrintOut
Dim i As Integer
For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) Then
        Sheets(ListBox1.List(i)).PrintOut
    End If
Next i
End Sub


Private Sub UserForm_Initialize()

Dim n As Integer

Do
n = n + 1

ListBox1.MultiSelect = fmMultiSelectMulti
ListBox1.AddItem Sheets(n).Name

Loop Until n = Worksheets.Count

End Sub

Yardımcı olması temennisiyle;

 

[askm]

Aşağıdaki kodları kullanın.

Sub ASKM_Yazdir()
Dim SonSat As Long
SonSat = Range("C" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next

For i = 2 To SonSat
    Sayfa = Split(Sheets("#").Cells(i, 3), " ")(0)
    Sheets(Sayfa).PrintPreview
'    Sheets(Sayfa).PrintOut
Next i
MsgBox "Yazdırma işlemi bitti...", vbInformation, "ASKM"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[bkr-ylmz]

Kodu kullandım ama, kod yazıcıya gönderiyor, direk PDF olarak kayıt edemiyor muyuz.

 

[askm]

Sub ASKM_Yazdir()
Dim SonSat As Long
SonSat = Range("C" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next

For i = 2 To SonSat
    Sayfa = Split(Sheets("#").Cells(i, 3), " ")(0)
    Sheets(Sayfa).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ThisWorkbook.Path & "\" & Sheets("#").Cells(i, 3), Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    'Sheets(Sayfa).PrintPreview

Next i
MsgBox "Yazdırma işlemi bitti...", vbInformation, "ASKM"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[bkr-ylmz]

Hocam yazdırma işlemi bitti diyor ama başka hiçbir hareket olmuyor, bir şeyleri yanlış mı yapıyorum acaba.
Gönderdiğiniz kodu modul ekleyerek oraya yapıştırıyorum, ardından makrodan çalıştır diyorum.

 

[askm]

Kodu yazdıktan sonra kaydedin. Kaydettiğiniz yere pdf çıkması gerekiyor.

 

[bkr-ylmz]

Şimdi 4 farklı excel dosyası açtı, sekme isimleri ve dosya isimleri c sutünundaki değerlerden oluşuyor.

İçeriği;
%PDF-1.5
%µµµµ
1 0 obj
<</Type/Catalog/Pages 2 0 R/Lang(tr-TR) /StructTreeRoot 10 0 R/MarkInfo<</Marked true>>>>
endobj
2 0 obj
<</Type/Pages/Count 1/Kids[ 4 0 R] >>
........... gibi devam ediyor.

 

[askm]

Dosyanız ektedir.