PDF olarak kaydetme hakkında

[mkarakas_58]

Merhaba arkadaşlar, hücre aralığındaki değerlerin sayısının 2 katı kadar, başka excel sayfadaki sayfaları pdf olarak kaydetmek istiyorum.

Aşağıdaki kodda yazdırma kodu var. Ben yazdırmasın sadece pdf formatında kaydetmesini istiyorum.

Yardım ederseniz sevinirim.

Sub yeniyoklama()

Dim i As String
    Sheets("EK1(Katılımcı)").Select
    i = WorksheetFunction.CountA(Range("C3:C52"))
    Sheets("İMZA FÖYÜ").Select
    Selection.Copy
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=i * 2, Copies:=1, Collate _
        :=True, IgnorePrintAreas:=False
    Sheets("ANA SAYFA").Select
    Range("B1:L1").Select
End Su

 

[PLİNT]

Merhaba
Aşağıdaki gibi deneyin.

[SIZE="2"][COLOR="Blue"]Sub yeniyoklama()[/COLOR]

Set ds = CreateObject("Scripting.FileSystemObject")
 yol = ThisWorkbook.Path & "\"
For Each a In Sheets("EK1(Katılımcı)").Range("C3:C52")
If a.Value <> "" Then
 For X = 1 To 2
If ds.FolderExists(yol & "İMZAPDF") = False Then ds.CreateFolder yol & "İMZAPDF"
Sheets("İMZA FÖYÜ").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
yol & "İMZAPDF\" & a.Value & X, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
  Next:
 End If
  Next
If X > 1 Then MsgBox "PDF DOSYALARI DOSYANIZIN YANINDA" & vbCrLf & "İMZAPDF KLASÖRÜNE KAYDEDİLDİ"
End Sub [/SIZE]