Note: The other languages of the website are Google-translated. Back to English

Excel'de vba ile bir e-postada belirli bir grafik nasıl gönderilir?

VBA kodu ile Excel'de Outlook üzerinden nasıl e-posta göndereceğinizi biliyor olabilirsiniz. Ancak, belirli bir çalışma sayfasındaki belirli bir grafiği e-postanın gövdesine nasıl ekleyeceğinizi biliyor musunuz? Bu makale size bu sorunu çözme yöntemini gösterecektir.

Excel'de bir e-postada VBA kodu ile belirli bir grafik gönderin


Excel'de bir e-postada VBA kodu ile belirli bir grafik gönderin

Excel'de VBA kodu ile bir e-postada belirli bir grafik göndermek için lütfen aşağıdaki işlemleri yapın.

1. Çalışma sayfasında, e-posta gövdesine eklemek istediğiniz grafiği içerir, Ara Toplam + F11 tuşlarını açmak için Uygulamalar için Microsoft Visual Basic pencere.

2. içinde Uygulamalar için Microsoft Visual Basic pencere, lütfen tıklayın Ekle > modül. Ardından, VBA kodunu Kod penceresine kopyalayın.

VBA kodu: Excel'de bir e-postada belirli bir grafik gönderin

Sub mailHTMLsend()
'Updated by Extendoffice 2018/3/5
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xStartMsg As String
    Dim xEndMsg As String
    Dim xChartName As String
    Dim xChartPath As String
    Dim xPath As String
    Dim xChart As ChartObject
    On Error Resume Next
    xChartName = Application.InputBox("Please enter the chart name:", "KuTools for Excel", , , , , , 2)
    If xChartName = "" Then Exit Sub
    Set xChart = Sheets("Sheet1").ChartObjects(xChartName) 'Change "Sheet1" to your worksheet name
    If xChart Is Nothing Then Exit Sub
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xStartMsg = "<font size='5' color='black'> Good Day," & "<br> <br>" & "Please find the chart below: " & "<br> <br> </font>"
    xEndMsg = "<font size='4' color='black'> Many Thanks," & "<br> <br> </font>"
    xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".bmp"
    xPath = "<p align='Left'><img src=" & "cid:" & Mid(xChartPath, InStrRev(xChartPath, "\") + 1) & """  width=700 height=500 > <br> <br>"
    xChart.Chart.Export xChartPath
    With xOutMail
        .To = "xrr@163.com"
        .Subject = "Add Chart in outlook mail body"
        .Attachments.Add xChartPath
        .HTMLBody = xStartMsg & xPath & xEndMsg
        .Display
    End With
    Kill xChartPath
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

not: Kodda, lütfen alıcının e-posta adresini ve e-posta konusunu satırda değiştirin .To = "xrr@163.com" ve çizgi .Subject = "Outlook posta gövdesine Grafik Ekle" , Sheet1 göndermek istediğiniz grafiği içeren sayfadır, lütfen kendi grafiğinizle değiştirin.

3. Tuşuna basın. F5 kodu çalıştırmak için anahtar. Açılışta Kutools for Excel iletişim kutusunda, e-posta gövdesine ekleyeceğiniz grafiğin adını girin ve ardından OK buton. Ekran görüntüsüne bakın:

Ardından, e-posta gövdesinde aşağıda gösterilen ekran görüntüsü gibi gösterilen belirli grafikle otomatik olarak bir e-posta oluşturulur. Bu e-postayı göndermek için lütfen Gönder düğmesine tıklayın.


İlgili yazılar:

 

 

 


En İyi Ofis Üretkenliği Araçları

Kutools for Excel Sorunlarınızın Çoğunu Çözer ve Verimliliğinizi% 80 Artırır

  • Yeniden: Hızlıca yerleştirin karmaşık formüller, grafikler ve daha önce kullandığınız her şey; Hücreleri Şifrele şifre ile; Posta Listesi Oluşturun ve e-posta gönder ...
  • Süper Formül Çubuğu (birden çok metin ve formül satırını kolayca düzenleyin); Okuma Düzeni (çok sayıda hücreyi kolayca okuyun ve düzenleyin); Filtrelenmiş Aralığa Yapıştır...
  • Hücreleri / Satırları / Sütunları Birleştirme Veri kaybetmeden; Bölünmüş Hücre İçeriği; Yinelenen Satırları / Sütunları Birleştirme... Yinelenen Hücreleri Önleyin; Aralıkları Karşılaştır...
  • Yinelenen veya Benzersiz'i seçin Satırlar; Boş Satırları Seçin (tüm hücreler boştur); Süper Bul ve Bulanık Bul Birçok Çalışma Kitabında; Rastgele Seçim ...
  • Tam kopya Formül referansını değiştirmeden Birden Çok Hücre; Otomatik Referans Oluştur Birden Çok Sayfaya; Madde İşaretleri Ekle, Onay Kutuları ve daha fazlası ...
  • Metni Çıkar, Metin Ekle, Konuma Göre Kaldır, Alanı Kaldır; Sayfalama Alt Toplamları Oluşturma ve Yazdırma; Hücre İçeriği ve Yorumları Arasında Dönüştür...
  • Süper Filtre (filtre şemalarını kaydedin ve diğer sayfalara uygulayın); Gelişmiş Sıralama ay / hafta / gün, sıklık ve daha fazlasına göre; Özel Filtre kalın, italik ...
  • Çalışma Kitaplarını ve Çalışma Sayfalarını Birleştirin; Tabloları anahtar sütunlara göre birleştirin; Verileri Birden Çok Sayfaya Bölme; Toplu dönüştürme xls, xlsx ve PDF...
  • 300'den fazla güçlü özellik. Office / Excel 2007-2021 ve 365'i destekler. Tüm dilleri destekler. Kuruluşunuzda veya kuruluşunuzda kolay devreye alma. Tam özellikler 30 günlük ücretsiz deneme. 60 günlük para iade garantisi.
kte sekmesi 201905

Office Tab, Office'e Sekmeli Arayüz Getirir ve İşinizi Çok Daha Kolay Hale Getirir

  • Word, Excel, PowerPoint'te sekmeli düzenlemeyi ve okumayı etkinleştirin, Publisher, Access, Visio ve Project.
  • Yeni pencereler yerine aynı pencerenin yeni sekmelerinde birden çok belge açın ve oluşturun.
  • Üretkenliğinizi% 50 artırır ve her gün sizin için yüzlerce fare tıklamasını azaltır!
ofis tabanı

 

 

Yorumları sıralama ölçütü
Yorumlar (13)
Henüz derecelendirme yok. İlk değerlendiren siz olun!
Bu yorum sitedeki moderatör tarafından en aza indirildi
grafik adını girdiğimde, posta iletişim kutusunu oluşturmuyor, sadece kapanıyor, neyi yanlış yaptığım hakkında bir fikriniz var mı? her adımı takip ettim
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sorun şu ki, Tablolar gibi Grafik Nesneleri için adlar belirleyemeyiz. Çalışmak için tamsayı kimliğini iletmeniz gerekir. Örneğin, "Sayfa1" de yalnızca 1 grafiğiniz varsa, mesaj kutusu göründüğünde 1 değerini iletmeyi deneyin.

Not: kötü ingilizce için üzgünüm :]
Bu yorum sitedeki moderatör tarafından en aza indirildi
hola como puede enviar por correo, tabla dinámica, y no un gráfico
Bu yorum sitedeki moderatör tarafından en aza indirildi
Kodda hata var: "\") + 1) & "" " genişlik=700 yükseklik=50 Kalın metinde ortadaki tek ters virgül olmalıdır

Bu yorum sitedeki moderatör tarafından en aza indirildi
Grafiği ek olarak içerir. Bunu posta gövdesine resim olarak nasıl ekleyeceğiniz konusunda bir fikriniz var mı? Teşekkürler, Youssef
Bu yorum sitedeki moderatör tarafından en aza indirildi
Aynı sorun, çözüm var mı?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba J,
Kod güncellendi. Lütfen bir deneyin. Rahatsızlıktan dolayı özür dileriz.


Sub mailHTMLsend()
'Updated by Extendoffice 2018/3/5
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xStartMsg As String
    Dim xEndMsg As String
    Dim xChartName As String
    Dim xChartPath As String
    Dim xPath As String
    Dim xChart As ChartObject
    On Error Resume Next
    xChartName = Application.InputBox("Please enter the chart name:", "KuTools for Excel", , , , , , 2)
    If xChartName = "" Then Exit Sub
    Set xChart = Sheets("Sheet1").ChartObjects(xChartName) 'Change "Sheet1" to your worksheet name
    If xChart Is Nothing Then Exit Sub
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xStartMsg = "<font size='5' color='black'> Good Day," & "<br> <br>" & "Please find the chart below: " & "<br> <br> </font>"
    xEndMsg = "<font size='4' color='black'> Many Thanks," & "<br> <br> </font>"
    xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".bmp"
    xPath = "<p align='Left'><img src="/%20&%20"cid:" & Mid(xChartPath, InStrRev(xChartPath, "\") + 1) & """  width=700 height=500 > <br> <br>"
    xChart.Chart.Export xChartPath
    With xOutMail
        .To = "xrr@163.com"
        .Subject = "Add Chart in outlook mail body"
        .Attachments.Add xChartPath
        .HTMLBody = xStartMsg & xPath & xEndMsg
        .Display
    End With
    Kill xChartPath
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,
yeni sevgilin mi załącza, czy coś tutaj należałoby wpisać jeszcze?
xPath = "co tutaj trzeba wprowadzić?"
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Kuba,
lütfen kaldırın / etiketle <img src="/.
Hata sitedeki editörden kaynaklanmaktadır.
Verdiğimiz rahatsızlıktan dolayı özür dilerim.
Bu yorum sitedeki moderatör tarafından en aza indirildi
cześć, pełny kod działa tylko do momentu podglądu komunikatu, przy wysyłce adresat otrzymuje błąd i wykresu nie widać ("Nie można wyświetlić połączonego obrazu. Plik mógł zostać przeniesiony lub usunięty albo zmieniono jego nazwę. Sprawdź czy łącze wskazuje poprawny plik i lokazlizację.") Czy z t ktoś miał czy tylko u mnie taki zonk muydu? Prosze o pomoc, tutaj kod, który dotyczy wykresum już tak mało brakuje :)

Dize Olarak Dim xChartName
Dize Olarak xChartPath'i Dim
xPath'i Dize Olarak Karartın
xChart'ı ChartObject Olarak Karartın
On Error Resume Next
Dize Olarak Dim wydzialy
wydzialy = liste.Hücreler(3, 75)
xChartName = Application.InputBox(wydzialy, "KuTools for Excel", , , , , , 2) 'Wykres1 '"Lütfen grafik adını girin:"
xChartName = "" ise, Sub'dan Çıkın
xChart = Sheets("Wykresy") olarak ayarlayın.ChartObjects(xChartName) '"Sayfa1"i çalışma sayfanızın adıyla değiştirin
xChart Hiçbir Şey Değilse, Sub'dan Çıkın
xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".svg" '.bmp '.svg '.svg ma lepsza jakość
xPath = " "
xChart.Chart.Export xChartPath


OutApp'i Nesne Olarak Karart
OutMail'i Nesne Olarak Karartın
Set OutApp = CreateObject("Outlook.Application")
OutMail'i Ayarla = OutApp.CreateItem(0)
OutMail ile
.Kime = e-postalar(b)
.CC = e-postalar_dw(b)
.Subject = "XXXX" ' - " & lista.Cells(i, 66)
.Ekler.xChartPath Ekle
.HTMLBody = "treść" ve xPath

.SendUsingAccount = OutApp.Session.Accounts.Item(1) olarak ayarlayın

.Görüntüle
İle bitmek
xChartPath'i öldür
OutMail'i Ayarla = Hiçbir Şey
OutApp'i Ayarla = Hiçbir Şey
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Kuba,
Kod güncellendi. Alıcı, grafiği normal şekilde görüntüleyebilir. Lütfen bir deneyin.
not: Kodda, lütfen "Grafik 1" kendi grafik adınıza. Ve Kime alanında e-posta adresini belirtin.
Sub mailHTMLsend()
'Updated by Extendoffice 20221013
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xStartMsg As String
    Dim xEndMsg As String
    Dim xChartName 'As String
    Dim xChartPath As String
    Dim xPath As String
    Dim xChart As ChartObject
    On Error Resume Next
    xChartName = "Chart 1" 'The name of the chart in the current worksheet you want to send.
    If xChartName = "" Then Exit Sub
    Set xChart = Application.ActiveSheet.ChartObjects(xChartName)
    If xChart Is Nothing Then Exit Sub
    
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    
    xStartMsg = "<font size='5' color='black'> Good Day," & "<br> <br>" & "Please find the chart below: " & "<br> <br> </font>"
    xEndMsg = "<font size='4' color='black'> Many Thanks," & "<br> <br> </font>"
    xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".bmp"
    
    xPath = "<p align='Left'><img src="/%20&%20"cid:" & Mid(xChartPath, InStrRev(xChartPath, "\") + 1) & """  width=700 height=500 > <br> <br>"
    
    xChart.Chart.Export xChartPath
    With xOutMail
        .To = "Email Address"
        .Subject = "Add Chart in outlook mail body"
        .Attachments.Add xChartPath
        .HTMLBody = xStartMsg & xPath & xEndMsg
        .Display
    End With
    Kill xChartPath
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
MERHABA, mail gövdesinde boşluk eklemek istiyorum, hangi anahtar kelimeyi kullanmalıyım?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba pavan chougule,
Koddaki aşağıdaki iki satır, e-posta gövde içeriğini içerir. Boşluk eklemek için klavyenizdeki boşluk tuşuna basarak e-posta gövdesini manuel olarak değiştirebilirsiniz.
xStartMsg = "<font size='5' color='black'> Good Day," & "<br> <br>" & "Please find the chart below: " & "<br> <br> </font>"
xEndMsg = "<font size='4' color='black'> Many Thanks," & "<br> <br> </font>"
Buraya henüz hiç yorum yapılmamış
Lütfen yorum yazın
Misafir olarak yayınlama
×
Bu gönderiyi değerlendirin:
0   Karakterler
Önerilen Konumlar

Bizi takip et

Telif Hakkı © 2009 - www.extendoffice.com. | Tüm hakları Saklıdır. Tarafından desteklenmektedir ExtendOffice. | | | Site Haritası
Microsoft ve Office logosu, Microsoft Corporation'ın Amerika Birleşik Devletleri ve / veya diğer ülkelerdeki ticari markaları veya tescilli ticari markalarıdır.
Sectigo SSL ile korunmaktadır