VBA - 选择多个数据透视表

编程问答 2022-05-26

问题描述

这是我的代码：

Private Sub CommandButton1_Click()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim MakeJPG As String
    Dim strbody As String    
    strbody = Worksheets("TXT Email").Range("A3").Value
    EndText = Replace(strbody,"   ","<br><br>")
      On Error Resume Next
        Set xOutApp = CreateObject("outlook.application")
    Set xOutMail = xOutApp.CreateItem(0)
       
     MakeJPG = copyRangetoJPG("APPS",Worksheets("APPS").Pivottables("Pivottable2").TableRange2.Address)

    If MakeJPG = "" Then
        MsgBox "Something went wrong,Could not complete operation."
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
        Exit Sub
    End If
    
                  On Error Resume Next
                  
    With xOutMail
        .To = Join(Application.Transpose(Worksheets("APPS").Range("AA7:AA10").Value),";")
        .CC = Join(Application.Transpose(Worksheets("APPS").Range("AA11:AA14").Value),";")
        .BCC = ""
        .Subject = Worksheets("TXT Email").Range("A2").Value
        .Attachments.Add MakeJPG,1,0
        .HTMLBody = EndText & "<html><p>" & "</p><img src=""cid:NamePicture.jpg"" width=600 height=300></html>" & vbNewLine
        .display
        
    End With
    
    On Error GoTo 0
    
    Set xOutMail = nothing
    Set xOutApp = nothing
    
End Sub

Function copyRangetoJPG(NameWorksheet As String,RangeAddress As String) As String
    Dim PictureRange As Range

    With ActiveWorkbook
        On Error Resume Next
        .Worksheets(NameWorksheet).Activate
        Set PictureRange = .Worksheets(NameWorksheet).Range(RangeAddress)
        
        If PictureRange Is nothing Then
            MsgBox "Sorry this is not a correct range"
            On Error GoTo 0
            Exit Function
        End If
        
        PictureRange.copyPicture
        With .Worksheets(NameWorksheet).ChartObjects.Add(PictureRange.Left,PictureRange.Top,PictureRange.Width,PictureRange.Height)
            .Activate
            .Chart.Paste
            .Chart.Export Environ$("temp") & Application.PathSeparator & "NamePicture.jpg","JPG"
        End With
        .Worksheets(NameWorksheet).ChartObjects(.Worksheets(NameWorksheet).ChartObjects.Count).Delete
    End With
    
    copyRangetoJPG = Environ$("temp") & Application.PathSeparator & "NamePicture.jpg"
    Set PictureRange = nothing
End Function

但我需要让它选择 2 个数据透视表，将它们组合起来，然后将其转换为 jpeg。

提前致谢。 ………………………………………………………………………………………………………………………………………………………… ……………………………………………………………………………………………………………………………………………………………… ………………………………………………………………………………………………………………………………………………………… ……………………………………………………………………………………………………………………………………………………………… ………………………………………………………………………………………………………………………………………………………… ……………………………………………………………………………………………………………………………………………………………… ………………………………………………………………………………………………………………………………………………………… ......................................

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

excelexceljpegpivot-tablevba