将数据透视表作为图像从Excel复制到Outlook电子邮件中

mfuanj7w 于 2022-12-24 发布在其他

关注(0)|答案(1)|浏览(314)

有一些问题，试图复制透视表从2个单独的excel工作表，包含在1个工作簿到outlook电子邮件作为图片。（特别想这样做作为图片，而不是转换为HTML表）
我已经尝试了几种不同的方法，但不断得到错误-希望一些建议？
我试着设置它，使它每小时运行一次，每小时，只要工作簿是打开的。
目前为止我所拥有的代码是：

Sub RefreshAndEmailPivotTables()
    Dim objOutlook As Object
    Dim objEmail As Object
    Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim pt1 As PivotTable
    Dim pt2 As PivotTable
    Dim time As String

    ' Get the current time and format it as a string
    time = Format(Now, "hh:mm")

    ' Set the worksheet and pivot table objects
    Set wb = ThisWorkbook
    Set ws1 = wb.Sheets("New Claims AHT")
    Set ws2 = wb.Sheets("Existing Claims AHT")
    Set pt1 = ws1.PivotTables("PivotTable1")
    Set pt2 = ws2.PivotTables("PivotTable1")

    ' Refresh all data connections
   ThisWorkbook.RefreshAll

    ' Create a new email in Outlook
    Set objOutlook = CreateObject("Outlook.Application")
    Set objEmail = objOutlook.CreateItem(0)

    ' Set the email properties and paste the pivot table images
    With objEmail
        .To = "@Leaders"
        .CC = "@Colleagues"
        .Subject = "Update - " & time
        .Body = "Here are the pivot tables:" & vbNewLine & vbNewLine
        .Body = .Body & "New Claims:" & vbNewLine
               
         'COPY PIVOTTABLE1 FROM "New Claims AHT" Sheet and paste into email body - Advice here please? :)
        
        .Body = .Body & vbNewLine & vbNewLine & "Existing Claims:" & vbNewLine
        
'COPY PIVOTTABLE1 FROM "Existing Claims AHT" Sheet - Advice here please? :)

        .Display
    End With

    ' Schedule the macro to run again in one hour
    Application.OnTime TimeValue("01:00:00"), "RefreshAndEmailPivotTables"

    ' Clean up
    Set objEmail = Nothing
    Set objOutlook = Nothing
    Set wb = Nothing
    Set ws1 = Nothing
    Set ws2 = Nothing
    Set pt1 = Nothing
    Set pt2 = Nothing
End Sub

我试过使用. copy和. paste，但是我得到一个对象不支持这个属性或方法错误。

excel

来源：https://stackoverflow.com/questions/74850559/copy-pivot-tables-from-excel-into-outlook-email-as-an-image

1条答案

按热度按时间

2w2cym1i1#

是的你可以做到这一点，你需要使用一个html主体，并使用我发现的这个函数来帮助导出范围为图像。
我只包含了生成电子邮件所需的部分。

Option Explicit
Sub RefreshAndEmailPivotTables()
    
    Dim objOutlook As Object
    Dim objEmail As Object
    Dim PivotImage As String
    Dim ImageName As String
    
    ' Create a new email in Outlook
    Set objOutlook = CreateObject("Outlook.Application")
    Set objEmail = objOutlook.CreateItem(0)
    
    PivotImage = "C:\Users\cameron\Documents\Workspaces\"
    ImageName = "MyImage"
    
    ' Save Pivot, you might need to some other stuff to figure out how to _
        identify used range for the pivot. You can alos do this twice with _
        different imagenames do get both pivots.
    SaveAsImage Sheet4.Range("C4:G16"), PivotImage & ImageName
    
    With objEmail
        .To = "@Leaders"
        .CC = "@Colleagues"
        .Subject = "Update - " & Time
        
        .Attachments.Add PivotImage & ImageName & ".png", 1, 0
        
        .HTMLBody = "<html><body>" & _
                    "Here are the pivot tables: <br> <br> " & _
                    "<img src=" & ImageName & ".png> <br> <br> " & _
                    "This is the line below <br> " & _
                    "And Another Line <br> " & _
                    "Here's Another <br> " & _
                    "You could add in your second pivot image here (same as first) <br> " & _
                    "</body></html>"
        
        '.Body = "Here are the pivot tables:" & vbNewLine & vbNewLine
        '.Body = .Body & "New Claims:" & vbNewLine
        'COPY PIVOTTABLE1 FROM "New Claims AHT" Sheet and paste into email body - Advice here please? :)
        '.Body = .Body & vbNewLine & vbNewLine & "Existing Claims:" & vbNewLine
        'COPY PIVOTTABLE1 FROM "Existing Claims AHT" Sheet - Advice here please? :)

        .Display
    End With
End Sub
Function SaveAsImage(RG As Range, Loc As String)
    
    'Found this in the form of a subruitine here:
    ' "https://software-solutions-online.com/excel-vba-save-table-as-jpeg/"
    ' by "azurous"
    ' Made a couple small changes but basically identical.
    ' Great little solution!
    
    Dim i  As Integer
    Dim intCount As Integer
    Dim objPic As Shape
    Dim objChart As Chart

    Call RG.CopyPicture(xlScreen, xlPicture)

    intCount = Sheet2.Shapes.Count
    For i = 1 To intCount
        Sheet2.Shapes.Item(1).Delete
    Next i

    Sheet2.Shapes.AddChart
    Sheet2.Activate
    Sheet2.Shapes.Item(1).Select
    Set objChart = ActiveChart

    objChart.Paste
    objChart.Export (Loc & ".png")
    
End Function

记住<br>在HTML中是换行符

赞(0）回复(0）举报 2022-12-24

我来回答

将数据透视表作为图像从Excel复制到Outlook电子邮件中

1条答案

相关问题

热门标签

最新问答