stackoom
  简体   繁体   中英

Macro to copy Named Charts, Pictures and Tables to Referenced Placeholders in PowerPoint

 原文  2021-02-02 13:35:24  6   1    excel/ vba/ powerpoint/ placeholder

Question

I have tried numerous versions of codes and loops to build the VBA to build a Macro to copy Named Charts, Pictures and Tables to Referenced Placeholders in PowerPoint but cannot seem to get anywhere with it. Any help would be greatly appreciated.

These are the placeholder references in PowerPoint with slide numbers and excel objects to go into them:

'Slide 2 - Chart Placeholder 2 - to move  
    ActiveSheetChartObjects("TeamAllocationsChart).Activate
    ActiveChartChartArea.Copy
    
'Slide 3 Picture placeholder 2
    ActiveSheetShapesRange(Array("Picture 8")).Select
    SelectionCopy
    
'Slide 3 Picture Placeholder 3
    ActiveSheetShapesRange(Array("Picture 9")).Select
    SelectionCopy
    
'Slide 3 Chart Placeholder 4
    ActiveSheetChartObjects("Chart 4").Activate
    ActiveChartChartAreaCopy
    
'Slide 3 - Chart Placeholder 5
    ActiveSheetChartObjects("Chart 5").Activate
    ActiveChartChartArea.Copy
    
'Slide 4 - Chart Placeholder 2
    ActiveSheetChartObjects("Chart 10").Activate
    ActiveChartPlotAreaSelect
    ActiveChartChartAreaSelect
    
'Slide 4 - Chart Placeholder 3
    ActiveChartChartAreaCopy
    ActiveSheetChartObjects("Chart 11").Activate
    
'Slide 5 -  Chart Placeholder 4
    ActiveChartChartArea.Copy
    ActiveSheetChartObjects("Chart 12").Activate
    
'Slide 5 -  Chart Placeholder 5
    ActiveChartChartAreaCopy
    ActiveSheetChartObjects("Chart 13").Activate
    
'Slide 6 -  Chart Placeholder 2
    ActiveChartChartAreaCopy
    ActiveSheetChartObjects("Chart 14").Activate
    
'Slide 6 -  Chart Placeholder 3
    ActiveChartChartAreaCopy
    ActiveSheetChartObjects("Chart 17").Activate
    
'Slide 7 -  Chart Placeholder 2
    ActiveChartChartAreaCopy
    ActiveSheetChartObjects("KPI - Business Instruction Form Usage").Activate
    
'Slide 7 -  Chart Placeholder 3
    ActiveChartChartAreaCopy
    ActiveSheetChartObjects("Chart 18").Activate
    
'Slide 8 -  Chart Placeholder 4
    ActiveChartChartAreaCopy
    ActiveSheetChartObjects("2019 Instruction Form Usage").Activate
    
'Slide 8 - Chart Placeholder 2
    ActiveChartChartArea.Copy
    ActiveSheetChartObjects("Chart 20").Activate
    
'Slide 8 -  Chart Placeholder 3
    ActiveChartChartArea.Copy
    ActiveSheetChartObjects("Chart 21").Activate
    
'Slide 9 -  Chart Placeholder 4
    ActiveChartChartAreaCopy
    ActiveSheetChartObjects("Chart 22").Activate
    
'Slide 9 -  Chart Placeholder 2
    ActiveChartChartAreaCopy
    ActiveSheetChartObjects("Chart 23").Activate
    
'Slide 9 -  Chart Placeholder 3
    ActiveChartChartAreaCopy
    ActiveSheetChartObjects("Chart 24").Activate
    
'Slide 10 -  Chart Placeholder 2
    ActiveCharthartAreaCopy
    ActiveSheetChartObjects("Chart 25").Activate
    
'Slide 10 -  Chart Placeholder 3
    ActiveChartChartAreaCopy
    ActiveSheetChartObjects("Chart 26").Activate
    
'Slide 11 -  Chart Placeholder 3
    ActiveChartChartAreaCopy
    ActiveSheetChartObjects("Chart 27").Activate
    
'Slide 12 -  Chart Placeholder 2
    ActiveChartChartAreaCopy
    ActiveSheetChartObjects("Chart 28").Activate
    
'Slide 12 -  Chart Placeholder 3
    ActiveChartChartArea.Copy
    ActiveSheetChartObjects("Chart 29").Activate
    
'Slide 13 -  Chart Placeholder 3
    ActiveChartChartAreaCopy
    ActiveSheetChartObjects("Chart 30").Activate
    
'Slide 14 -  Table Placeholder 2
    Range("E234:F248").Select
    SelectionCopy
    
'Slide 14 - Table Placeholder 3
    Range("E252:F256").Select
    ApplicationCutCopyMode = False
    SelectionCopy

1 answers

solution1
 0  2021-02-05 10:31:49

Sub LeadershipDashboardCompleted()

'Add a reference to the Microsoft PowerPoint Library by: '1. Go to Tools in the VBA menu '2. Click on Reference '3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay

'First we declare the variables we will be using
    Dim newPowerPoint As PowerPoint.Application
    Dim MySlide As PowerPoint.Slide
    Dim nPlcHolder As Long
    Dim oPP As PowerPoint.Presentation
 
 'Look for existing instance
    On Error Resume Next
    Set newPowerPoint = GetObject(, "PowerPoint.Application")
    On Error GoTo 0
 
'Let's create a new PowerPoint
    If newPowerPoint Is Nothing Then
        Set newPowerPoint = New PowerPoint.Application
    End If
    
'Make a presentation in PowerPoint
    If newPowerPoint.Presentations.Count = 0 Then
        newPowerPoint.Presentations.Add
    End If
 
'Show the PowerPoint
    newPowerPoint.Visible = True
        
'Copy Chart Team Allocations Chart
    ActiveSheet.ChartObjects("TeamAllocationsChart").Activate
    ActiveChart.ChartArea.Copy
    
'Go to the slide 2 on the template
    Set MySlide = oPP.Slides(2)
    
 'Select the placeholder shape
    oPP.Slides(2).Placeholders("Chart Placeholder 3").Shapes.PasteSpecial(DataType:=ppPasteDefault).Select
            
'Copy Picture Chart 2018
    ActiveSheet.Shapes.Range(Array("Picture 8")).Select
    Selection.Copy

    'Go to the slide 3 on the template
    Set MySlide = oPP.Slides(3)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Picture Placeholder 3"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With
    
'Paste into the Selection
    With oPP
    nPlcHolder = "Picture Placeholder 3"
    .Slides(1).Shapes.Placeholders(nPlcHolder).View.Paste
    End With
    
  'Copy Picture Chart 2019
   ActiveSheet.Shapes.Range(Array("Picture 9")).Select
    Selection.Copy

'Go to the slide 3 on the template
    Set MySlide = oPP.Slides(3)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Picture Placeholder 5"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    With oPP
    nPlcHolder = "Picture Placeholder 5"
    .Slides(1).Shapes.Placeholders(nPlcHolder).View.Paste
    End With
    
'Copy Chart 4 - 2020 Monthly Volumes
    ActiveSheet.ChartObjects("Chart 4").Activate
    ActiveChart.ChartArea.Copy

'Go to the slide 3 on the template
    Set MySlide = oPP.Slides(3)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Chart Placeholder 4"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With
    
'Paste into the Selection
    ActiveWindow(1).View.Paste

'Copy Chart 5 - 2021 Monthly Volumes
    ActiveSheet.ChartObjects("Chart 5").Activate
    ActiveChart.ChartArea.Copy

'Go to the slide 3 on the template
    Set MySlide = oPP.Slides(3)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Chart Placeholder 8"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    ActiveWindow(1).View.Paste

'Copy Chart 10 - Allocation of Complex Matters 2020
    ActiveSheet.ChartObjects("Chart 10").Activate
    ActiveChart.ChartArea.Copy
    
'Go to the slide 4 on the template
    Set MySlide = oPP.Slides(4)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Chart Placeholder 4"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    ActiveWindow(1).View.Paste

'Copy Chart 11 - Allocation of Complex Matters 2021
    ActiveSheet.ChartObjects("Chart 11").Activate
    ActiveChart.ChartArea.Copy

'Go to the slide 4 on the template
    Set MySlide = oPP.Slides(4)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Chart Placeholder 8"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    ActiveWindow(1).View.Paste

'Copy Chart 12 - Submitting Team - 2020
    ActiveSheet.ChartObjects("Chart 12").Activate
    ActiveChart.ChartArea.Copy

'Go to the slide 5 on the template
    Set MySlide = oPP.Slides(5)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Chart Placeholder 4"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    ActiveWindow(1).View.Paste

'Copy Chart 13 - Submitting Team - 2021
    ActiveSheet.ChartObjects("Chart 13").Activate
    ActiveChart.ChartArea.Copy

'Go to the slide 5 on the template
    Set MySlide = oPP.Slides(5)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Chart Placeholder 5"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    ActiveWindow(1).View.Paste

 'Copy Chart 14 - 2020 Marketing v. Non
    ActiveSheet.ChartObjects("Chart 14").Activate
    ActiveChart.ChartArea.Copy

'Go to the slide 6 on the template
    Set MySlide = oPP.Slides(6)

 'Select the placeholder shape
   With oPP
    nPlcHolder = "Chart Placeholder 2"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    ActiveWindow(1).View.Paste
        
'Copy Chart 17 - 2021 Marketing v. Non
    ActiveSheet.ChartObjects("Chart 17").Activate
    ActiveChart.ChartArea.Copy

 'Go to the slide 6 on the template
    Set MySlide = oPP.Slides(6)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Chart Placeholder 3"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    ActiveWindow(1).View.Paste

 'Copy Chart 2020 KPI - Business Instruction Form Usage
    ActiveSheet.ChartObjects("KPI - Business Instruction Form Usage").Activate
    ActiveChart.ChartArea.Copy

'Go to the slide 7 on the template
    Set MySlide = oPP.Slides(7)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Chart Placeholder 2"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    ActiveWindow(1).View.Paste

'Copy Chart 18 - 2021 Business Instruction Form Usage
    ActiveSheet.ChartObjects("Chart 18").Activate
    ActiveChart.ChartArea.Copy

 'Go to the slide 7 on the template
    Set MySlide = oPP.Slides(7)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Chart Placeholder 3"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    ActiveWindow(1).View.Paste

'Copy Chart 2019 Pie Instruction Form Usage
    ActiveSheet.ChartObjects("2019 Instruction Form Usage").Activate
    ActiveChart.ChartArea.Copy

 'Go to the slide 8 on the template
    Set MySlide = oPP.Slides(8)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Chart Placeholder 4"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    ActiveWindow(1).View.Paste

'Copy Chart 20 - 2020 Pie Instruction Form Usage
    ActiveSheet.ChartObjects("Chart 20").Activate
    ActiveChart.ChartArea.Copy

'Go to the slide 8 on the template
    Set MySlide = oPP.Slides(8)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Chart Placeholder 2"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    ActiveWindow(1).View.Paste

'Copy Chart 21 - 2021 Pie Instruction Form Usage
    ActiveSheet.ChartObjects("Chart 21").Activate
    ActiveChart.ChartArea.Copy

 'Go to the slide 8 on the template
    Set MySlide = oPP.Slides(8)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Chart Placeholder 3"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    ActiveWindow(1).View.Paste

'Copy Chart 22 - 2019 Pie SLA
    ActiveSheet.ChartObjects("Chart 22").Activate
    ActiveChart.ChartArea.Copy

'Go to the slide 9 on the template
    Set MySlide = oPP.Slides(9)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Chart Placeholder 4"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    ActiveWindow(1).View.Paste

'Copy Chart 23 - 2020 Pie SLA
    ActiveSheet.ChartObjects("Chart 23").Activate
    ActiveChart.ChartArea.Copy

'Go to the slide 9 on the template
    Set MySlide = oPP.Slides(9)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Chart Placeholder 2"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    ActiveWindow(1).View.Paste

'Copy Chart 24 - 2021 Pie SLA
    ActiveSheet.ChartObjects("Chart 24").Activate
    ActiveChart.ChartArea.Copy

'Go to the slide 9 on the template
    Set MySlide = oPP.Slides(9)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Chart Placeholder 3"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    ActiveWindow(1).View.Paste

'Copy Chart 25 - 2020 SLA By Submitting Team
    ActiveSheet.ChartObjects("Chart 25").Activate
    ActiveChart.ChartArea.Copy

 'Go to the slide 10 on the template
    Set MySlide = oPP.Slides(10)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Chart Placeholder 2"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    ActiveWindow(1).View.Paste

'Copy Chart 26 - 2021 SLA By Submitting Team
    ActiveSheet.ChartObjects("Chart 26").Activate
    ActiveChart.ChartArea.Copy

'Go to the slide 10 on the template
    Set MySlide = oPP.Slides(10)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Chart Placeholder 3"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    ActiveWindow(1).View.Paste

'Copy Chart 27 - Yearly First Time Approval
    ActiveSheet.ChartObjects("Chart 27").Activate
    ActiveChart.ChartArea.Copy

 'Go to the slide 11 on the template
    Set MySlide = oPP.Slides(11)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Chart Placeholder 3"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    ActiveWindow(1).View.Paste

 'Copy Chart 28 - Team 2020 First Time Approval
    ActiveSheet.ChartObjects("Chart 28").Activate
    ActiveChart.ChartArea.Copy

 'Go to the slide 12 on the template
    Set MySlide = oPP.Slides(12)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Chart Placeholder 2"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    ActiveWindow(1).View.Paste

 'Copy Chart 29 - Team 2021 First Time Approval
    ActiveSheet.ChartObjects("Chart 29").Activate
    ActiveChart.ChartArea.Copy

'Go to the slide 12 on the template
    Set MySlide = oPP.Slides(12)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Chart Placeholder 3"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    ActiveWindow(1).View.Paste

 'Copy Chart 30 - First Time Approval Submitting Team
    ActiveSheet.ChartObjects("Chart 30").Activate
    ActiveChart.ChartArea.Copy

'Go to the slide 13 on the template
    Set MySlide = oPP.Slides(13)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Chart Placeholder 3"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    ActiveWindow(1).View.Paste

'Copy Pivot Table - 2020 Reasons
    Range("E233:F248").Select
    Selection.Copy

 'Go to the slide 14 on the template
    Set MySlide = oPP.Slides(14)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Table Placeholder 2"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    ActiveWindow(1).View.Paste

'Copy Pivot Table - 2021 Reasons
    Range("E251:F256").Select
    Selection.Copy

'Go to the slide 14 on the template
    Set MySlide = oPP.Slides(14)
    
 'Select the placeholder shape
   With oPP
    nPlcHolder = "Table Placeholder 3"
    .Slides(1).Shapes.Placeholders(nPlcHolder).Select msoTrue
    End With

'Paste into the Selection
    ActiveWindow(1).View.Paste

AppActivate ("Microsoft PowerPoint")
Set MySlide = Nothing
Set newPowerPoint = Nothing

End Sub

暂无
暂无

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

Related Question Copy Excel charts and tables to Powerpoint Excel to Powerpoint (But with tables not pictures) Export Excel charts as pictures to PowerPoint Copy all tables and charts from all sheets of Excel to PowerPoint Copy dynamic pictures in Excel to PowerPoint VBA to copy paste all charts and tables from Excel file for all sheets to PowerPoint file Copy/paste Excel charts to PowerPoint Error Copy all charts from excel into an existing powerpoint Copy/paste Excel charts to PowerPoint and break links How to copy data from Powerpoint charts into Excel
Related Tags
 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM