将命名图表、图片和表格复制到 PowerPoint 中引用的占位符的宏

【问题标题】：Macro to copy Named Charts, Pictures and Tables to Referenced Placeholders in PowerPoint将命名图表、图片和表格复制到 PowerPoint 中引用的占位符的宏
【发布时间】：2021-02-02 13:35:24
【问题描述】：

我尝试了许多版本的代码和循环来构建 VBA 来构建宏以将命名图表、图片和表格复制到 PowerPoint 中的引用占位符，但似乎无法使用它。任何帮助将不胜感激。

这些是 PowerPoint 中的占位符引用，其中包含幻灯片编号和 Excel 对象：

'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

【问题讨论】：

  • 我试过看Mr.Excel； Chandoo.org；电子表格大师；更好的解决方案；微软、Automateexcel 和许多其他公司
  • 我不理解您的代码清单。你做了很多复制，但没有粘贴。以下是 Stack Overflow 关于如何提出好问题的指南：stackoverflow.com/help/how-to-ask 请参阅有关创建最小可重现示例的部分。
  • 您好 John Korchok - 抱歉，这是我尝试开始工作但无法解决的完整代码：

标签： excel vba powerpoint placeholder


【解决方案1】：

Sub LeadershipDashboardCompleted()

'通过以下方式添加对 Microsoft PowerPoint 库的引用： '1。转到 VBA 菜单中的工具 '2。点击参考 '3。向下滚动到 Microsoft PowerPoint X.0 对象库，选中该框，然后按确定

'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

结束子

【讨论】：

  • 我有点困惑。您是否弄清楚并回答了自己的问题？或者您不知道如何编辑您的原始帖子以修改代码？
  • 我不知道如何编辑我的原始代码。我仍然无法让这段代码工作，我不知道为什么
猜你喜欢
  • 1970-01-01
  • 2015-03-10
  • 1970-01-01
  • 2020-05-18
  • 1970-01-01
  • 2010-10-07
  • 1970-01-01
  • 1970-01-01
  • 2019-06-11
相关资源
最近更新 更多
热门标签
Java Python linux javascript Mysql C# Docker 算法 前端 SpringBoot Redis Vue spring 设计模式 .net core .net kubernetes c++ 数据库 数据结构 大数据 js 机器学习 微服务 Android Go 程序员 面试 JVM ASP.net core 云原生 人工智能 后端 PHP git CSS golang k8s Nginx Django mybatis 深度学习 多线程 React 架构 devops 爬虫 云计算 Spring Boot LeetCode