ListBoxta seçilen sayfaları PDF olarak Kaydetme

[Feylosof]

İyi geceler,

Ekli Dosyada Listbox üzerinde sayfalar listelenmektedir. Hangilerini seçersem o sayfaları PDF olarak kaydetmek istiyorum. Saygıyla

 

[Feylosof]

...

 

[halit3]

kod

Private Sub CommandButton3_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
yer = ActiveSheet.Name
Dim myArray() As Variant
Dim i As Integer

son = 0
For i = 1 To ListBox1.ListCount
If ListBox1.Selected(i - 1) = True Then
son = 1
Exit For
End If
Next
If son = 0 Then
MsgBox "Sayfa seçimi yapmadınız"
Exit Sub
End If

Dosya_Adı = ActiveWorkbook.Name
Sayfa_Adı = ActiveSheet.Name

For i = 1 To ListBox1.ListCount
If ListBox1.Selected(i - 1) = True Then
ReDim Preserve myArray(n)
myArray(n) = i
n = n + 1
End If
Next

Sheets(myArray).Select

Dim yol As String
Application.DisplayAlerts = False
yol = ThisWorkbook.Path
say = CreateObject("Scripting.FileSystemObject").GetFolder(yol).Files.Count + 1

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=yol & "\" & say & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True

Application.ScreenUpdating = True
Application.DisplayAlerts = True

 Sheets(yer).Select
MsgBox "İşlem Tamam", vbInformation, " U Y A R I "

End Sub

 

[Feylosof]

Sayın @halit3 üstadım çok teşekkür ediyorum. Eliniz dert görmesin. Sağlıcakla kalın.