尝试创建一封 Outlook 电子邮件,其中将 Excel 范围粘贴为电子邮件中的 jpg,以及前后的文本。类似:
文本
图片 1
图片 2
更多文本
但是,我不知道如何将 Excel 范围转换为图像并将其粘贴到 Outlook 电子邮件中,而不会覆盖那里的文本。当前代码如下(匿名),重点关注 .HTMLBody 部分。感觉这应该很简单,但我无法弄清楚确切的代码。
Sub GenerateEmail()
' Declare variables
Dim outlookApp As Object
Dim MItem As Object
Dim Recipients As String
Dim Subject As String
Dim Body1 As String
Dim Body2 As String
Dim ws As Worksheet
Dim EmailList As Range
Dim Cell As Range
Dim table1 As Range
Dim table2 As Range
Dim ExcRng As Range
' Set the email subject and body
Subject = "Subject"
Body1 = Sheet1.Range("B11")
Body2 = Sheet1.Range("B12")
' Set the range that includes the list of email addresses
Set EmailList = Sheet1.Range("b11:b11")
' Copy the range as an image and paste it into the email
Set ws = ThisWorkbook.Sheets("sheet1")
Set table1 = ThisWorkbook.Sheets("sheet2").Range("A1:I21")
Set table2 = ThisWorkbook.Sheets("sheet3").Range("A4:W41")
table1.Copy
table2.Copy
' Create a new Outlook email
Set outlookApp = CreateObject("Outlook.Application")
Set MItem = outlookApp.CreateItem(olMailItem)
' Add the recipients, subject, and body to the email
With MItem
.To = ws.Range("G4")
.Subject = ws.Range("B7")
'Add message before ranges
.HTMLBody = ws.Range("B9") & "<br>" & "<br>" & ws.Range("B10") _
**& RangeToJPG(table2) _
& RangeToJPG(table1) _**
& "<br>" & "<br>" & "<br>" & "<br>" & ws.Range("B11")
.Display
End With
Set Message = Nothing
Set Email = Nothing
End Sub
对于 RangetoJPG,我尝试使用另一个用户的以下代码。但是,它会为每个图像创建一个新的电子邮件,而我并不想这样做。我无法确定如何将所有内容保留在同一个 Outlook 电子邮件项目中。
Function RangeToJPG(rng As Range)
'Copy range of interest
rng.Copy
'Open a new mail item
Dim outlookApp As Outlook.Application
Set outlookApp = CreateObject("Outlook.Application")
Dim OutMail As Outlook.MailItem
Set OutMail = outlookApp.CreateItem(olMailItem)
'Get its Word editor
OutMail.Display
Dim wordDoc As Word.Document
Set wordDoc = OutMail.GetInspector.WordEditor
'To paste as picture
wordDoc.Range.PasteAndFormat wdChartPicture
End Function