首页 文章

如何将Excel工作表中的文本和图表复制到Outlook正文?

提问于
浏览
2

我试图将excel表中的文本(单元格的恒定范围)和图表复制到outlook主体,但到目前为止,我成功地只复制了图表而不是文本 . 我想知道将文本(在所选范围内)和图表从excel表复制到Outlook消息的最佳方法 . 以下是我现在使用的代码 . 此代码粘贴文本,但图表在文本上重叠(当图表粘贴在电子邮件正文中时) . 我想如何格式化outlook电子邮件并粘贴文本和图表而不重叠 .

Sub email_Charts(sFileName, Subject1)
Dim r As Integer
Dim o As Outlook.Application
Dim m As Outlook.MailItem
Dim wEditor As Word.Document
Set o = New Outlook.Application
Dim olTo As String

Windows("Daily_Status_Macro_Ver3.0.xlsm").Activate
Sheets("Main").Select
olTo = Worksheets("Main").Cells(3, 3).Value

Windows(sFileName).Activate

msg = "<HTML><font face = Calibri =2>"
msg = msg & "Hi All, <br><br>"
msg = msg & "Please find Daily Status Below "
msg = msg & "<b><font color=#0033CC>"
msg = msg & Sheets(1).Range("B2:B4")


    Set m = o.CreateItem(olMailItem)
    m.To = olTo

    m.Subject = Subject1
    m.BodyFormat = olFormatHTML
    m.HTMLBody = msg
    m.Display

 Windows(sFileName).Activate
 Sheets(1).Select
 ActiveSheet.DrawingObjects.Select
 Selection.Copy
 Set wEditor = o.ActiveInspector.wordeditor
 m.Body = msg
 wEditor.Application.Selection.Paste
 'm.send

    Workbooks(sFileName).Close SaveChanges:=False
End Sub

1 回答

  • 3

    也许是这样的:

    Sub createJpg(Namesheet As String, nameRange As String, nameFile As String)
        ThisWorkbook.Activate
        Worksheets(Namesheet).Activate
        Set Plage = ThisWorkbook.Worksheets(Namesheet).Range(nameRange)
        Plage.CopyPicture
        With ThisWorkbook.Worksheets(Namesheet).ChartObjects.Add(Plage.Left, Plage.Top, Plage.Width, Plage.Height)
            .Activate
            .Chart.Paste
            .Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG"
        End With
        Worksheets(Namesheet).ChartObjects(Worksheets(Namesheet).ChartObjects.Count).Delete
    Set Plage = Nothing
    End Sub
    

    在您现有的代码中:

    Set appOutlook = CreateObject("outlook.application")
    'create a new message
    Set Message = appOutlook.CreateItem(olMailItem)
    With Message
        .HTMLBody = "Hello" ' and whatever else you need in the text body
        'first we create the image as a JPG file
        Call createJpg("Dashboard", "B8:H9", "DashboardFile")
        'we attached the embedded image with a Position at 0 (makes the attachment hidden)
        TempFilePath = Environ$("temp") & "\"
        .Attachments.Add TempFilePath & "DashboardFile.jpg", olByValue, 0
    
        'Then we add an html <img src=''> link to this image
        'Note than you can customize width and height - not mandatory
    
        .HTMLBody = .HTMLBody & "<br><B>WEEKLY REPPORT:</B><br>" _
            & "<img src='cid:DashboardFile.jpg'" & "width='814' height='33'><br>" _
            & "<br>Best Regards,<br>Ed</font></span>"
    
        .To = "contact1@email.com; contact2@email.com"
        .Cc = "contact3@email.com"
    
        .Display
        '.Send
    End With
    

相关问题