• Web sitemize destek olmak, Hazır Excel Dosyaları indirmek ve sitemizi reklamsız kullanmak için VIP Üyelik Satın alabilirsiniz.
    Hesabını VIP Üyeliğe Yükselt

Çözüldü Pdf kaydet ve sayfaları email gönder

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
B

Believing

VIP
VIP
Kullanıcı
Yaş
52
Versiyon
  1. Excel 2013
Sürüm
  1. 32 bit
Dil
  1. Türkçe

Reputation:

Sayın Uzman arkadaşlar,

Aşağıdaki alıntı olan kod ile aktif sayfayı ".pdf" formatında e-mail gönderiyorum.
Aktif sayfa yerine "LICENSE", "TEMPLATE", "PARAMETRE", "SETTINGS" sayfaları hariç, diğer sayfaları tek bir pdf dosyası olarak göndermek istiyorum.
Outlook'a eklenecek PDF dosyası ismini, çalışma kitabı ismi ile "SETTINGS" isimli sayfanın "H3" hücresi birleştirilerek gönderilmelidir.(Örnek; "E-Mail Gönder-01.04.2021")
Yukarıda belirttiğim koşulları sağlamak için mevcut kodu nasıl revize etmeliyim.
Benim için çok değerli olan yardımlarınızı rica ederim.

Saygılarımla.

Kod: 
Sub AttachActiveSheetPDF()
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String
Dim OutlApp As Object

' Not sure for what the Title is
Title = Range("H20")

' Define PDF filename
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"

' Export activesheet as PDF
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With

' Use already open Outlook if possible
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0

' Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)

' Prepare e-mail
.Subject = Title
.To = Range("H13") ' <-- Put email of the recipient here
.CC = Range("H17") ' <-- Put email of 'copy to' recipient here
.Body = Range("h23")
.Attachments.Add PdfFile

' Try to send
On Error Resume Next
.Send
Application.Visible = True
If Err Then
MsgBox "E-mail was not sent", vbExclamation
Else
MsgBox "E-mail successfully sent", vbInformation
End If
On Error GoTo 0

End With

' Delete PDF file
Kill PdfFile

' Quit Outlook if it was created by this code
If IsCreated Then OutlApp.Quit

' Release the memory of object variable
Set OutlApp = Nothing

End Sub
 
Çözüm
Ömer BARAN
Aşağıdaki gibi dener misiniz Sayın @Believing .

C#: 
Sub AttachActiveSheetPDF()
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String
Dim OutlApp As Object

' Not sure for what the Title is
Set bukitap = ThisWorkbook
Set s = bukitap.Sheets("SETTINGS")
Title = s.Range("H20")

' Define PDF filename
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & "_" & Sheets("SETTINGS").[H3] & ".pdf"

' Export activesheet as PDF
For Each shf In bukitap.Sheets
    If shf.Name <> "LICENSE" And shf.Name <> "TEMPLATE" And shf.Name <> "PARAMETRE" And shf.Name <> "SETTINGS" Then
        XD1 = XD1 + 1
        If XD1 = 1 Then...
Tarihe göre sırala Oylamaya göre sırala
B

Believing

VIP
VIP
Kullanıcı
Yaş
52
Versiyon
  1. Excel 2013
Sürüm
  1. 32 bit
Dil
  1. Türkçe

Reputation:

Sayın Uzman arkadaşlar,

Ekteki örnek çalışmada ilk mesajda istenenlerden bazılarını yapabildim.
Eksik kalan senaryoları tamamlamak için yardımlarınızı rica ediyorum.
Aktif sayfa yerine "LICENSE", "TEMPLATE", "PARAMETRE", "SETTINGS" sayfaları hariç, diğer sayfaları tek bir pdf dosyası olarak gönderilmelidir.
"SETTINGS" sayfasının "H23", "H25", "H31" hücrelerinde metinleri alt alta sıralanmsını sağlamak için mevcut kodları nasıl revize etmeliyim.

Saygılarımla.
 

Ekli dosyalar

  • Outlook Üzerinden Mail Gönderme.xlsm
    2 MB · Görüntüleme: 3
Upvote 0 Negatif oyla
Ömer BARAN

Ömer BARAN

Kurucu
Yönetici
Kurucu
Versiyon
  1. Excel 2013
Sürüm
  1. 32 bit
Dil
  1. Türkçe

Reputation:

Örnek belgenizi incelemedim.
Aşağıdaki konu sayfasında Sayın @AhmetRasim 'in verdiği 23 numaralı cevaptaki kod aradığınız sorunun cevabı sanıyorum.
İlgili cevap metnine de bakarsanız, PDF yapılırken hariç tutulacak sayfa isimlerinin koda nasıl dahil edieceği de belirtilmiş.
İncelersiniz.

www.exceldestek.com

Çözüldü - Çalışma Sayfasını Başka Kitaba Kopyalama Sorunu

Merhaba Bir Excel dosyasındaki sayfayı başka bir excel kitabına kopyalarken aşağıdaki resimde görülen hatayı almaktayım. Kopyalamak istediğim sayfa Hedef Excel dosyasını paylaşmasam olmaz mı ?
www.exceldestek.com www.exceldestek.com
 
Upvote 0 Negatif oyla
B

Believing

VIP
VIP
Kullanıcı
Yaş
52
Versiyon
  1. Excel 2013
Sürüm
  1. 32 bit
Dil
  1. Türkçe

Reputation:

Sayın Uzman arkadaşlar,

Konu aktif olup, henüz kendi uğraşlarım neticesinde herhangi bir sonuca ulaşamadım.
Benim için çok değerli olan yardımlarınızı rica ederim.

Saygılarımla.
 
Upvote 0 Negatif oyla
B

Believing

VIP
VIP
Kullanıcı
Yaş
52
Versiyon
  1. Excel 2013
Sürüm
  1. 32 bit
Dil
  1. Türkçe

Reputation:

Sayın Ömer bey,
Ömer BARAN' Alıntı:
Örnek belgenizi incelemedim.
Aşağıdaki konu sayfasında Sayın @AhmetRasim 'in verdiği 23 numaralı cevaptaki kod aradığınız sorunun cevabı sanıyorum.
İlgili cevap metnine de bakarsanız, PDF yapılırken hariç tutulacak sayfa isimlerinin koda nasıl dahil edieceği de belirtilmiş.
İncelersiniz.

www.exceldestek.com

Çözüldü - Çalışma Sayfasını Başka Kitaba Kopyalama Sorunu

Merhaba Bir Excel dosyasındaki sayfayı başka bir excel kitabına kopyalarken aşağıdaki resimde görülen hatayı almaktayım. Kopyalamak istediğim sayfa Hedef Excel dosyasını paylaşmasam olmaz mı ?
www.exceldestek.com www.exceldestek.com
Genişletmek için tıkla ...

Sayın Ömer bey,

Maalesef müsbet bir neticeye ulaşamadım.
Sadece dijital imzamı görselleri ile eklemeyi sağlayabildim
".HTMLBody = Range("H23") & .HTMLBody"
Aşağıda kalan iki senaryoyu çözemedim.
Tüm sayfalar yerine "LICENSE", "TEMPLATE", "PARAMETRE", "SETTINGS" isimli sayfaları hariç, diğer sayfaları tek bir pdf dosyası olarak gönderilmelidir.
"SETTINGS" sayfasının "H23", "H25", "H31" hücrelerinde metinleri alt alta sıralanmasını sağlamak için mevcut kodları nasıl revize etmeliyim.
Benim için çok kıymetli olan yardımlarınızı rica ediyorum.

Saygılarımla.
 
Upvote 0 Negatif oyla
Ömer BARAN

Ömer BARAN

Kurucu
Yönetici
Kurucu
Versiyon
  1. Excel 2013
Sürüm
  1. 32 bit
Dil
  1. Türkçe

Reputation:

Bilgisayarımda OUTLLOOK kullanılmadığı için deneme şansım yok.

Tahmin üzerine yazıyorum.
-- HTMLBODY: Kırmızı renklendirdiğiniz satırdan önce, ilgili hücrelerin içeriği olan metinleri aralara satırbaşı karakteri ekleyerek birleştirip mesaj = .... şeklinde bir değişkene alsanız ve HtmlBody satırını da HtmlBody = mesaj şeklinde yazmayı,
-- PDF'de yer almayacak sayfaları kodun en başında GİZLİ hale getirseniz (sadece e-postayla gönderilecek safalar görünür halde kalsa) ve Activesheet.ExportAsFixedFormat Typ..... yerine Activeworkbook.ExportAsFixedFormat Typ......... şeklinde işlem yapmayı ve PDF satırından sonra da gizlenen sayfaları tekrar görünür hale getirecek kod satırları eklemeyi,
dener misiniz?
 
Upvote 0 Negatif oyla
Ömer BARAN

Ömer BARAN

Kurucu
Yönetici
Kurucu
Versiyon
  1. Excel 2013
Sürüm
  1. 32 bit
Dil
  1. Türkçe

Reputation:

Aşağıdaki gibi dener misiniz Sayın @Believing .

C#: 
Sub AttachActiveSheetPDF()
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String
Dim OutlApp As Object

' Not sure for what the Title is
Set bukitap = ThisWorkbook
Set s = bukitap.Sheets("SETTINGS")
Title = s.Range("H20")

' Define PDF filename
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & "_" & Sheets("SETTINGS").[H3] & ".pdf"

' Export activesheet as PDF
For Each shf In bukitap.Sheets
    If shf.Name <> "LICENSE" And shf.Name <> "TEMPLATE" And shf.Name <> "PARAMETRE" And shf.Name <> "SETTINGS" Then
        XD1 = XD1 + 1
        If XD1 = 1 Then
            bukitap.Sheets(shf.Name).Copy
        Else
            bukitap.Sheets(shf.Name).Copy After:=ActiveWorkbook.Sheets(1)
            XD = ActiveWorkbook.Sheets.Count
            Sheets(ActiveSheet.Name).Move After:=Sheets(XD)
        End If
    End If
Next

With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
ActiveWorkbook.Close 0
' Use already open Outlook if possible
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0

' Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)
.Display
' Prepare e-mail
.Subject = Title
.To = s.Range("H13") ' <-- Put email of the recipient here
.CC = s.Range("H17") ' <-- Put email of 'copy to' recipient here
.HTMLBody = s.[H23].Text & "<br><br>" & s.[H25].Text & "<br><br>" & s.[H31].Text
'.HTMLBody = msj 'Range("H23") & vbLf & [H25] & .HTMLBody
.Attachments.Add PdfFile

' Try to send
On Error Resume Next
'.Send
Application.Visible = True
If Err Then
MsgBox "Üzgünüz e-mail gönderilemedi", vbExclamation
Else
MsgBox "E-mail göderme işlemi tamamlandı", vbInformation
End If
On Error GoTo 0

End With

' Delete PDF file
Kill PdfFile

' Quit Outlook if it was created by this code
If IsCreated Then OutlApp.Quit

' Release the memory of object variable
Set OutlApp = Nothing

End Sub
 
Upvote 0 Negatif oyla
Çözüm
B

Believing

VIP
VIP
Kullanıcı
Yaş
52
Versiyon
  1. Excel 2013
Sürüm
  1. 32 bit
Dil
  1. Türkçe

Reputation:

Sayın Ömer bey,

Ellerinize ve emeğinize sağlık oldukça güzel olmuş. Ayrıca eski kodları silmeden yaptığınız çalışma benim için çok öğretici olmuştur.
ALLAH sizden ve sevdiklerinizden razı olsun.
Hakkınızı helal ediniz lütfen.
Ramazan ayının sizlere hayırlar getirmesini dilerim.

Saygılarımla,
 
Upvote 0 Negatif oyla
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...

Benzer Konular

Cengizhan
  • Çözüldü
Çözüldü Kodda revize listbox için değişiklik
Cevaplar
4
Görüntüleme
35
Cengizhan
Cengizhan
B
  • Kilitli
  • Çözüldü
Çözüldü Togglebutton ile sayfa gizle göster
Cevaplar
4
Görüntüleme
54
Believing
B
M
  • Çözüldü
Çözüldü İki Userform Arası Koşullu Veri Çekme
Cevaplar
2
Görüntüleme
46
mertatakan_3838
M
Z
Soru Excelden webWhatsApp ile Toplu Mesaj Atma
Cevaplar
2
Görüntüleme
52
Zafer1974
Z
S
  • Kilitli
  • Çözüldü
Çözüldü Koşullu biçimlendirme ile şema düzenleme
2
Cevaplar
30
Görüntüleme
182
selis
S
C
Soru ListView Kolon Başlıkları Nerede?
Cevaplar
7
Görüntüleme
89
CemalTekin
C
T
Soru Açılış sayfası boş satırları gizleme ekmakro
Cevaplar
5
Görüntüleme
70
teyadih
T
Erol U.
  • Çözüldü
Çözüldü MsgBox ta dosya uzantısının yazdırılmaması
Cevaplar
9
Görüntüleme
99
Erol U.
Erol U.
M
Soru VBA ile Kaydedip Çıkış Nasıl Yapılır
Cevaplar
2
Görüntüleme
61
merakli
M
M
  • Çözüldü
Çözüldü SUB İçinde Diziden Gelen Veriyi Görebilmek
Cevaplar
9
Görüntüleme
170
merakli
M
Üst