Aynı anda bir çok sayfayı ayrı ayrı PDF olarak kaydetmek

[kamenzü]

Merhaba,

Şu an aktif olarak kullandığım bir form ile;

bir çok çalışma sayfası içerisinden istediklerimi,

sayfa numaraları birbirine karışmadan ayrı ayrı yazdırabiliyorum.


Sorumdan önce yukarıda yazdığım konuda yardımını esirgemeyen,

Kodu baştan aşağı yazan sayın Halit3'e ve düzenleme konusunda yardımcı olan sayın Hüseyin Çoban'a teşekkür ederim.

Sorum şu;

Aşağıda verdiğim kod'u şu şekilde nasıl değiştirebiliriz;

Seçilen çalışma sayfalarını ayrı ayrı PDF olarak kaydetsin ve
dosya isimlerini de her çalışma sayfasının BA1 hücresinden alsın.


CAHİL KİŞİ'NİN TAVSİYESİ; mevcut kod seçilen çalışma sayfalarını ayrı ayrı işleme aldığı için sadece PDF olarak kaydetme işleminin koda entegre edilmesi iş görür diye düşünüyorum.

Saygılarımla.

Private Sub CheckBox1_Click()
Dim liste As Integer

For liste = 1 To ListBox1.ListCount
ListBox1.Selected(liste - 1) = CheckBox1.Value
Next
End Sub
Private Sub CommandButton1_Click()
Dim liste As Integer

For liste = 1 To ListBox1.ListCount
If ListBox1.Selected(liste - 1) = True Then
Sheets(ListBox1.List(liste - 1, 0)).PrintOut
ListBox1.Selected(liste - 1) = False
End If
Next
End Sub


Private Sub ListBox1_Click()

End Sub

Private Sub UserForm_Initialize()
ListBox1.ListStyle = 1
ListBox1.MultiSelect = fmMultiSelectExtended
For i = ActiveWorkbook.Sheets.Count To 1 Step -1
ListBox1.AddItem Sheets(i).Name
Next i

End Sub

 

[kamenzü]

Kod içerisinde koyu ve altı çizili olarak işaretlediğim kısmı değiştirdim,

Ancak seçtiğim çalışma sayfalarında işlem yapıyor gibi görünse de;

sadece 1 dosya kaydediyor ve

seçili çalışma sayfasının adını veriyor.

Private Sub CheckBox1_Click()
Dim liste As Integer

For liste = 1 To ListBox1.ListCount
ListBox1.Selected(liste - 1) = CheckBox1.Value
Next
End Sub
Private Sub CommandButton1_Click()
Dim liste As Integer

For liste = 1 To ListBox1.ListCount
If ListBox1.Selected(liste - 1) = True Then
Sheets(ListBox1.List(liste - 1, 0)).[B][I][U]PrintOut[/U][/I][/B]
ListBox1.Selected(liste - 1) = False
End If
Next
End Sub


Private Sub ListBox1_Click()

End Sub

Private Sub UserForm_Initialize()
ListBox1.ListStyle = 1
ListBox1.MultiSelect = fmMultiSelectExtended
For i = ActiveWorkbook.Sheets.Count To 1 Step -1
ListBox1.AddItem Sheets(i).Name
Next i

End Sub

Yeni kod şu şekilde,

Private Sub CheckBox1_Click()
Dim liste As Integer

For liste = 1 To ListBox1.ListCount
ListBox1.Selected(liste - 1) = CheckBox1.Value
Next
End Sub
Private Sub CommandButton1_Click()
Dim liste As Integer

[B][I][U]yol = ActiveWorkbook.Path
isim = Format(Range("BA1").Value, "")[/U][/I][/B]

For liste = 1 To ListBox1.ListCount
If ListBox1.Selected(liste - 1) = True Then
Sheets(ListBox1.List(liste - 1, 0)).[B][I][U]ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
yol & "-" & isim & ".pdf", _
Quality:=xlQualityStandard, IgnorePrintAreas:=False, IncludeDocProperties:=True[/U][/I][/B]ListBox1.Selected(liste - 1) = False
End If
Next
End Sub


Private Sub ListBox1_Click()

End Sub

Private Sub UserForm_Initialize()
ListBox1.ListStyle = 1
ListBox1.MultiSelect = fmMultiSelectExtended
For I = ActiveWorkbook.Sheets.Count To 1 Step -1
ListBox1.AddItem Sheets(I).Name
Next I

End Sub

 

[kamenzü]

merhaba,

konuyla ilgili bir tavsiyesi veya fikri olan yok mu?