Question

在将这段代码拼凑在一起时，我能够使其正常运行。以为我做完了，我把它提交给了一个试图将其添加为个人宏的人，那时我们才意识到它不能正常工作。为了验证，我将其作为个人宏添加到了自己的计算机上，但仍然无法正常工作。

在ChartObject.Activate之后我盲目地尝试了一些代码添加，例如ThisWorkbook.Activate，但是没有成功。

Sub RangeToEmailBody()

        Dim TempFilePath As String
        Dim xOutApp As Object
        Dim xOutMail As Object
        Dim xHTMLBody As String
        Dim xRg As Range
        On Error Resume Next
        Set xRg = Application.InputBox(prompt:="Please select the data range:", Type:=8)
        If xRg Is Nothing Then Exit Sub
        With Application
            .Calculation = xlManual
            .ScreenUpdating = False
            .EnableEvents = False
        End With
        Set xOutApp = CreateObject("outlook.application")
        Set xOutMail = xOutApp.CreateItem(olMailItem)

        Call createJpg(ActiveSheet.Name, xRg.Address, "DashboardFile")
        TempFilePath = Environ$("temp") & "\"
        xHTMLBody = "<span LANG=EN>" _
                & "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
                & "<img src='cid:DashboardFile.jpg'>"
        With xOutMail
            .Subject = ""
            .HTMLBody = xHTMLBody
          .Attachments.Add TempFilePath & "DashboardFile.jpg", olByValue
            .To = " "
            .Cc = " "
            .Display
        End With
End Sub

Sub createJpg(SheetName As String, xRgAddrss As String, nameFile As String)

    Dim xRgPic As Range
    ThisWorkbook.Activate
    Worksheets(SheetName).Activate
    Set xRgPic = ThisWorkbook.Worksheets(SheetName).Range(xRgAddrss)
    xRgPic.CopyPicture
    With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(xRgPic.Left, xRgPic.Top, xRgPic.Width, xRgPic.Height)
        .Activate
        .Chart.Paste
        .Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG"
    End With
    Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete

Set xRgPic = Nothing
End Sub

我希望所选范围显示在电子邮件的正文中，但作为个人宏，“图片”中没有内容。

Answer 1

这是对问题的猜测。如果要将其添加到个人宏中，则ThisWorkbook是指个人工作簿。我猜您的来源范围完全在另一本工作簿中。

为简化起见，我将使用一个临时的新工作簿来执行以下操作：

Sub createJpg(rng As Range, nameFile As String)

    Dim tempChartObj As ChartObject
    Dim tempWb As Workbook

    Set tempWb = Workbooks.Add
    Set tempChartObj = tempWb.Sheets(1).ChartObjects.Add(rng.Left, rng.Top, rng.Width, rng.Height)

    rng.CopyPicture
    With tempChartObj
        .Activate
        .Chart.Paste
        .Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG"
    End With

    tempWb.Close SaveChanges:=False

End Sub

然后这样称呼它（请注意，Call是不必要的）：

createJpg xRg, "DashboardFile"

个人宏不起作用：选择范围并将其粘贴到Outlook电子邮件正文中

1 个答案: