粘贴每个图表后,如何在电子邮件正文中添加换行符?

时间:2015-07-15 04:52:13

标签: excel vba

我希望这封电子邮件能够将图表粘贴在彼此之下,目前它们只是粘贴在一个系列中,看起来非常混乱。 粘贴每个图表后,如何在电子邮件正文中添加换行符?我尝试过使用白色,并粘贴空白单元格,但它要么无效,要么我没有正确使用它。

非常感谢

Private Sub CommandButton21_Click()

On Error Resume Next

Dim weekno As Long
Dim oApp As Outlook.Application
Dim oMail As MailItem
Dim wrdEdit

ActiveSheet.Select
weekno = Range("C2").Value

'get running Outlook Application
Set oApp = GetObject(, "Outlook.Application")
'create a new email
Set oMail = oApp.CreateItem(olMailItem)
'set the subject and recipient
oMail.Subject = "Execution and Unavailability Report for Week " & weekno
oMail.To = ""
'show it
oMail.Display
'change to HTML
oMail.BodyFormat = olFormatHTML
'get the word editor
Set wrdEdit = oApp.ActiveInspector.WordEditor


ActiveSheet.Range("A50").Select
Selection.Copy
wrdEdit.Application.Selection.Paste

ActiveSheet.Range("A51").Select
Selection.Copy
wrdEdit.Application.Selection.Paste

ActiveSheet.Range("A52").Select
Selection.Copy
wrdEdit.Application.Selection.Paste

ActiveSheet.Range("A53").Select
Selection.Copy
wrdEdit.Application.Selection.Paste

    ActiveSheet.ChartObjects(1).Activate
    ActiveChart.ChartArea.Copy
    wrdEdit.Application.Selection.Paste

    ActiveSheet.ChartObjects(2).Activate
    ActiveChart.ChartArea.Copy
    wrdEdit.Application.Selection.Paste


    Sheets("ACT Statistics").Select
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.ChartArea.Copy
 wrdEdit.Application.Selection.Paste

    Sheets("ATD Statistics").Select
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.ChartArea.Copy

'paste it into the email
wrdEdit.Application.Selection.Paste


'use oMail.Send to autosend
'release objects
Set wrdEdit = Nothing
Set oMail = Nothing
Set oApp = Nothing
End Sub

0 个答案:

没有答案