微信公众号搜"智元新知"关注
微信扫一扫可直接关注哦!

VBA - 选择多个数据透视表

如何解决VBA - 选择多个数据透视表

这是我的代码

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 举报,一经查实,本站将立刻删除。