VBA Copying pivot table to powerpoint slide

[mjohnston0209]

I am working on a macro that will transfer several objects from a specific sheet (sheet2) in excel and onto a specific slide in PowerPoint. I watched a very informative video on how to do this. The objects copied in the video were a range, table, and chart. This all works for me. However, I also need to copy pivot tables.

Below is the code I am currently using. I need to add pivot table coding to two areas. One is under 'Create array to house objects we want to export' and the other is under 'Depending on the object type, copy it a certain way'.

Any help would be greatly appreciated!

Sub CopyObject()

'Declare PowerPoint Variables
Dim PPTApp As PowerPoint.Application
Dim PPTPres As PowerPoint.Presentation
Dim PPTSlide As PowerPoint.Slide
Dim PPTShape As PowerPoint.Shape

'Declare Excel Variables
Dim ExcObj, ObjType, ObjArray As Variant
Dim LefArray, TopArray, HgtArray, WidArray As Variant
Dim x As Integer

'Open Instance of PowerPoint
Set PPTApp = New PowerPoint.Application
    PPTApp.Visible = True
    PPTApp.Presentations.Open "C:\Users\mjohnston\Desktop\Presentation1.pptx"
    PPTApp.Activate

'Create a reference to the slide we want to work with and delete all shapes on slide
Set PPTSlide = PPTApp.ActivePresentation.Slides(2)

TotalShapes = PPTSlide.Shapes.Count

    For i = TotalShapes To 1 Step -1

    If PPTSlide.Shapes(i).Type <> msoTextBox Then PPTSlide.Shapes(i).Delete
    
    Next i

'Create array to house objects we want to export
ObjArray = Array(Sheet2.Range("B2:D5"), Sheet2.ChartObjects(1), Sheet2.ListObjects(1))

'Define my dimesnion arrays
LefArray = Array(59.3)
TopArray = Array(270)
HgtArray = Array(105.27)
WidArray = Array(359.23)

'Loop through the object array and copy each object

For x = LBound(ObjArray) To UBound(ObjArray)

    'Determine Object Type
    ObjType = TypeName(ObjArray(x))
    
    'Depending on the object type, copy it a certain way
    Select Case ObjType
    
        Case "Range"
            Set ExcObj = ObjArray(x)
                ExcObj.Copy
                
        Case "ChartObject"
            Set ExcObj = ObjArray(x)
                ExcObj.Chart.ChartArea.Copy
                
        Case "ListObject"
            Set ExcObj = ObjArray(x)
                ExcObj.Range.Copy
    
    End Select

    'Pause the Excel Application
    Application.Wait Now() + #12:00:01 AM#
    
    'Past the object in the slide
    PPTSlide.Shapes.PasteSpecial DataType:=ppPasteOleOjbect
    
    'Set a reference to the shape
    Set PPTShape = PPTSlide.Shapes(PPTSlide.Shapes.Count)
    
    'Set the dimension of my shape
    With PPTShape
        .Left = LefArray(x)
        .Height = HgtArray(x)
        .Width = WidArray(x)
        .Top = TopArray(x)
            
    End With

Next

End Sub

 

[smozgur]

Object definition: PivotTables() collection object.

'Create array to house objects we want to export
ObjArray = Array(Sheet2.Range("B2:D5"), Sheet2.ChartObjects(1), Sheet2.ListObjects(1), Sheet2.PivotTables(1))

Copying the range: TableRange1 or TableRange2 properties.

Case "PivotTable"
    Set ExcObj = ObjArray(x)
        ExcObj.TableRange1.Copy

Good article about Referencing Pivot Table Ranges in VBA.

Referencing Pivot Table Ranges in VBA - Peltier Tech

This tutorial explains how to reference various parts of a pivot table using VBA code.

peltiertech.com

 

[mjohnston0209]

Object definition: PivotTables() collection object.

'Create array to house objects we want to export
ObjArray = Array(Sheet2.Range("B2:D5"), Sheet2.ChartObjects(1), Sheet2.ListObjects(1), Sheet2.PivotTables(1))

Copying the range: TableRange1 or TableRange2 properties.

Case "PivotTable"
    Set ExcObj = ObjArray(x)
        ExcObj.TableRange1.Copy

Good article about Referencing Pivot Table Ranges in VBA.

Referencing Pivot Table Ranges in VBA - Peltier Tech

This tutorial explains how to reference various parts of a pivot table using VBA code.

peltiertech.com

Works perfectly! Exactly like I wanted.

Any advice on the graphs in the separate post? If not, no worries and thanks again.

 

[smozgur]

Glad to hear it helps.

Any advice on the graphs in the separate post? If not, no worries and thanks again.

I'll try to take a look at it, but I am not a real graph person, so I might not be that helpful.

 

[smozgur]

What is the difference between the range image you posted in the first post and the additional post? Do you want me to change the image in the first post and remove your second post, so it would look "no answer" yet?

 

[mjohnston0209]

What is the difference between the range image you posted in the first post and the additional post? Do you want me to change the image in the first post and remove your second post, so it would look "no answer" yet?

I realized that I didn't screenshot the entire screen (show the row and column headers) in my first post. I always find it easier when I see the cells the data is captured in. That is why I added the second post. I couldn't figure out how to add the additional screenshot to my first post. Then I saw the second post makes it look as if it the thread was answered. Can you remove it?

 

[smozgur]

Can you remove it?

Creating a Stack/Clustered Bar Chart

I was asked to put together a bar chart that shows daily actual progress per activity and compare it it to the weekly plan. I am not sure how to do this without creating two labels and entering the plan as daily values. Any help would be greatly appreciated!

www.mrexcel.com

 

[mjohnston0209]

Creating a Stack/Clustered Bar Chart

I was asked to put together a bar chart that shows daily actual progress per activity and compare it it to the weekly plan. I am not sure how to do this without creating two labels and entering the plan as daily values. Any help would be greatly appreciated!

www.mrexcel.com

Tried to message you, but the system wouldn't allow it. Interested in another thread?

Add data label only to the last value of one series in graph with multiple series

I recently discovered a macro that allows users to add a data label to the last value of all the series within a graph. How would I change it to focus on only a specific series? The series name would be Actual. Below is the code. Sub LastPointLabel() Dim mySrs As Series Dim iPts As Long...

www.mrexcel.com

Hope all is well.

 

[mjohnston0209]

Object definition: PivotTables() collection object.

'Create array to house objects we want to export
ObjArray = Array(Sheet2.Range("B2:D5"), Sheet2.ChartObjects(1), Sheet2.ListObjects(1), Sheet2.PivotTables(1))

Copying the range: TableRange1 or TableRange2 properties.

Case "PivotTable"
    Set ExcObj = ObjArray(x)
        ExcObj.TableRange1.Copy

Good article about Referencing Pivot Table Ranges in VBA.

Referencing Pivot Table Ranges in VBA - Peltier Tech

This tutorial explains how to reference various parts of a pivot table using VBA code.

peltiertech.com

Any chance you can look at this thread?

Use VBA to enter a varying range of bullet points into body of email