• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Sayfaları PDF olarak yazdırma

sinnernekolens

Altın Üye
Katılım
23 Temmuz 2009
Mesajlar
310
Excel Vers. ve Dili
Ofis 2019 - Türkçe 64bit
Değerli üstadlar, aşağıdaki kod ile excel deki sayfa1'i pdf ye cevirip e-mail e ekliyor. Sizlerden isteğim aynı çalışma kitabı içindeki sayfa2, sayfa3, sayfa4 de pdf yapıp e-maile ekleyebilirmiyiz.

Kod:
Sub Metinkutusu2_Tıklat()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Yol As String, Dosya_Adi As String

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Yol = ThisWorkbook.Path
    Dosya_Adi = Yol & "\" & Format(Range("G5").Value, "yyyy-mm-dd-hh-mm") & " - " & Format(Now, "dd-mm-yy hh.mm") & " - PDA.pdf"
    
    Sheets("Sayfa1").Range("A1:u60").ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Dosya_Adi, Quality:=xlQualityStandard, IncludeDocProperties:=True
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = Format(Range("G5").Value, "yyyy-mm-dd-hh-mm") & " - " & Format(Now, "dd-mm-yy hh.mm") & " - PDA"
        .Body = "İyi günler," & Chr(10) & Chr(10) & "Ekte sunulmuştur." & Chr(10) & Chr(10) & "İyi çalışmalar."
        .Attachments.Add Dosya_Adi
        .Display
    End With
    On Error GoTo 0
    Kill Dosya_Adi

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub
 
Geri
Üst