Aktif makroyu pdf e çevirme

[_GÜRCAN_]

Merhabalar, Aşağıdaki makro pdf olarak dönüştürüle bilir mi.
yani yazdır makrosundaki düzen ile pdf olarak kaydetmek istiyorum.
yardımlarınız için şimdiden teşekkürler.



Private Sub YAZDIR_Click()
son = Cells(Rows.Count, "AH").End(3).Row
ActiveSheet.Range("$AH$1:$AO$" & son).AutoFilter Field:=7, Criteria1:="<>"
ActiveSheet.PageSetup.PrintArea = "$AH$1:$AO$" & Cells(Rows.Count, 1).End(3).Row + 1424
ActiveSheet.PrintOut
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
MsgBox "Yazdırma işlemi tamamlanmıştır.", vbInformation
End Sub

 

[okan32]

Deneyiniz

Private Sub YAZDIR_Click()
    Dim son As Long
    son = Cells(Rows.Count, "AH").End(xlUp).Row

    ' Aktif sayfanın filtrelemesini uygula
    ActiveSheet.Range("$AH$1:$AO$" & son).AutoFilter Field:=7, Criteria1:="<>"

    ' PDF dosyasının kaydedileceği masaüstü yolunu ve dosya adını belirleyin
    Dim masaustuYolu As String
    Dim dosyaAdi As String
    masaustuYolu = "C:\Users\KullaniciAdi\Desktop\" ' Kullanıcı adınızı ekleyin
    dosyaAdi = ActiveSheet.Range("A3").Value & ".pdf"

       ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=masaustuYolu & dosyaAdi, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

    ' Filtreyi kaldır
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0
        End Sub

 

[_GÜRCAN_]

Deneyiniz

Private Sub YAZDIR_Click()
    Dim son As Long
    son = Cells(Rows.Count, "AH").End(xlUp).Row
  
    ' Aktif sayfanın filtrelemesini uygula
    ActiveSheet.Range("$AH$1:$AO$" & son).AutoFilter Field:=7, Criteria1:="<>"
  
    ' PDF dosyasının kaydedileceği masaüstü yolunu ve dosya adını belirleyin
    Dim masaustuYolu As String
    Dim dosyaAdi As String
    masaustuYolu = "C:\Users\KullaniciAdi\Desktop\" ' Kullanıcı adınızı ekleyin
    dosyaAdi = "Belge.pdf"
  
       ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=masaustuYolu & dosyaAdi, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  
    ' Filtreyi kaldır
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0
        End Sub

okan32 merhaba, dosya adı değişken olduğundan butona bastığımda aktif sayfa A3 ten yazdırabilirmiyiz.
teşekkürler,

 

[okan32]

okan32 merhaba, dosya adı değişken olduğundan butona bastığımda aktif sayfa A3 ten yazdırabilirmiyiz.
teşekkürler,

2. mesajımı düzenledim

 

[_GÜRCAN_]

2. mesajımı düzenledim

okan32, çok teşekkür ediyorum.
iyi çalışmalar dilerim.