我有一个Excel工作表，它根据数据验证列表更新了许多图表和表格。我有以下代码循环验证列表，复制选定的范围，并发布到新的PowerPoint。
从透视表中提取的图表在整个复制和粘贴过程中不会更新。
有人可以提供一些指导吗？我尝试过设置'等待'功能，以及其他功能，例如
Application.Calculate
If Not Application.CalculationState = xlDone Then
DoEvents
End If
无济于事。以下是当前代码:(编辑为包含循环函数但仍创建单独的PPT）
Sub Loop_Through_List()
Dim cell As Excel.Range
Dim rgDV As Excel.Range
Dim DV_Cell As Excel.Range
Dim rng As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
Dim pvtTbl As PivotTable
'Create an Instance of PowerPoint
On Error Resume Next
'Is PowerPoint already opened?
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
'Clear the error between errors
Err.Clear
'If PowerPoint is not already open then open PowerPoint
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
'Optimize Code
Application.ScreenUpdating = False
'Create a New Presentation
Set myPresentation = PowerPointApp.Presentations.Add
'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Add(1, 12) '12 = ppLayoutBLANK
Set DV_Cell = Range("A2")
Worksheets("Main Tab - Comp").Calculate
Set rgDV = Application.Range(Mid$(DV_Cell.Validation.Formula1, 2))
For Each cell In rgDV.Cells
DV_Cell.Value = cell.Value
'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Add(1, 12) '12 = ppLayoutBLANK
'Copy Range from Excel
Set rng = ThisWorkbook.ActiveSheet.Range("A3:AA52")
'Copy Excel Range
rng.Copy
'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
'Set position:
myShape.Left = 0
myShape.Top = 0
'Make PowerPoint Visible and Active
PowerPointApp.Visible = True
PowerPointApp.Activate
'Clear The Clipboard
Application.CutCopyMode = False
Next
End Sub
好。所以这不是你可能希望的万能药。我的目标是接受您的代码，对其进行一些更改，讨论一些一般性的想法/原则，希望能帮助您构建自己的解决方案。
其他用户可能希望将其用于解决您的任务更有用。问题在于需要解决很多问题，其中很多内容更适合代码审查。
任务：
您希望循环一系列单元格并重复将更新的范围从Excel复制到powerpoint演示文稿中的新幻灯片。
问题：
您正在创建powerpoint和新powerpoint演示文稿的重复实例，而不是将范围复制到同一演示文稿中的新幻灯片。
必需（伪代码）过程：
这基本上就是这个过程。你会想要错误处理等，但这超出了我打算放在这里的范围。
首先要做的事......
把它放在代码的顶部。它强制显式声明所有变量并在其使用中查找拼写错误等。如果您想要它总是on，您可以去解决方案资源管理器>选择项目>项目>属性>编译选项卡。
1）范围
您的程序范围是隐式公开的，所以让我们明确说明：
Public Sub Loop_Through_List()
2）优化
您希望在代码顶部使用ScreenUpdating进行优化。没有人希望屏幕在开始时闪烁，直到您关闭屏幕更新。并记得在最后重新打开它！
如果您依赖于范围浆料的计算值，请注意优化以关闭计算。
Public Sub Loop_Through_List()
Application.ScreenUpdating = False
3）变量和声明
你的“宣言之墙”：
Dim cell As Excel.Range
Dim rgDV As Excel.Range
Dim DV_Cell As Excel.Range
Dim rng As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
Dim pvtTbl As PivotTable
我们可以在这堵墙上切掉：
a）变量可以声明为尽可能接近实际使用。这使代码更容易阅读。请参阅完整代码，了解如何实现此功能。
b）Dim cell As Excel.Range - 不确定官方线是什么，但由于代码在Excel中运行，如果你完全符合你的范围，我认为你可以放弃Excel，即只是Dim cell As Excel.Range。
除了，
c）给你的变量有意义的名字，这不会引起混淆，即不是cell，也不是保留的keywords，例如Call，编译器用来确定代码的结构
所以有意义的东西，当对象表示你正在迭代一系列单元格时，可能是：
Dim currentCell As Range
因为角色不会花费你任何东西，你可以慷慨地扩展
DV_Cell to DataValidationCell
我个人也会尽可能避免使用变量名称中的“_”。
在线提供大量有关命名约定的资源，包括避免匈牙利表示法和正确使用的案例。一个例子是this。
d）Late binding versus early binding。当你说时，你正在使用后期绑定
Dim myPresentation As Object
在分发代码时这很好，并且您不知道您的用户具有哪个版本的应用程序。
您还可以使用早期绑定，特别是用于开发，因为它可以快速编译并在当前对象上提供智能感知，即在您键入时弹出相关的属性/方法列表。
早期绑定相同的是：
Dim myPresentation As Presentation
e）删除未使用的变量
可能你没有包括所有的代码，但目前没有pvtTbl，所以这条线，Dim pvtTbl As PivotTable，可以去。
f）使用变量来保存对象并完全限定对象。
它使代码更易于阅读，并确保您使用预期的对象。
这样做：
Dim targetBook As Workbook
Dim wsMain As Worksheet
Set targetBook = ThisWorkbook
Set wsMain = targetBook.Worksheets("Main Tab - Comp")
表示以下行：
Set DV_Cell = Range("A2")
Worksheets("Main Tab - Comp").Calculate
变得清晰和具体
Set DV_Cell = wsMain.Range("A2")
wsMain.Calculate
注意：由于原始帖子缺乏特异性，我不得不假设你是DV_Cell的主要标签。
还有这个：
Set rng = ThisWorkbook.ActiveSheet.Range("A3:AA52")
我不清楚ThisWorkbook.ActiveSheet是wsMain但是一定要使用实际的工作表名称。我重写为：
Set rng = wsMain.Range("A3:AA52")
4）代码排序
确保代码流遵循我在开始时描述的伪代码过程。或者，在您自己的过程中，尝试写出psuedo代码过程，检查它，然后确保您的代码匹配。
一个例子是：
Worksheets("Main Tab - Comp").Calculate
我改写为：
wsMain.Calculate
我把它放在循环中，因为我认为你想根据DV_Cell值的变化刷新计算;在循环中发生变化。
5）模块化代码和单一责任原则
模块化代码是一种常见做法。有一个子/功能做一件事。我在这里列举了一个例子，函数GetPPT，你如何能够得到演示文稿。
引用RubberDuck OOP VBA Part1 Debunking Stuff
单一责任原则是一个黄金法则，在VBA中与其他任何语言一样难以理解：编写一个小程序和功能，做一件事，更喜欢许多小型专用模块而不是更少，更大的。
该文章还有很多内容可供参考。
6）滑动指数
在下面的行中，1是slide index
Set mySlide = myPresentation.Slides.Add(1, 12)
如果要定位不同的幻灯片，则需要使用其他索引。
7）默认属性
DV_Cell.Value = currentCell.Value可以成为
DV_Cell = currentCell
.Value是Range对象的默认属性。你可以指定currentCell.Value或缩短到currentCell
8）增加对象引用（听起来很奇怪！）
关于我之前的幻灯片索引评论。增加粘贴的位置和形状。
Set mySlide = .Slides.Add(.Slides.Count + 1, 12)
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
9）循环中的下一个控制变量
你在哪里，
Next
，明确命名迭代器，即
Next currentCell
特别是使用多个循环，这使得阅读事物变得更加容易。
1O）避免创建多个powerpoint /应用程序
除了确保在复制循环之外创建应用程序和新演示文稿之外，还要确保关闭/退出演示文稿和powerpoint应用程序不在复制范围循环中。
11）保存演示文稿
根据演示文稿是否已存在，或者您是否创建了新演示文稿，您将需要代码来指定保存更改的文件。
12）释放资源
记得在完成后摆脱powerpoint应用程序。
.Quit
例子，不完美，代码：
Option Explicit
Public Sub Loop_Through_List() 'You can add a reference to MS Powerpoint in tools references to take advantage of faster early binding and intellisense
'Optimize Code
Application.ScreenUpdating = False 'optimization at start
Dim PowerPointApp As PowerPoint.Application 'Object
Set PowerPointApp = GetPPT 'We now have a powerpoint presenation
Dim myPresentation As Presentation 'Object
Dim mySlide As Slide 'Object
Dim myShape As PowerPoint.Shape 'Object
'Create a New Presentation
Set myPresentation = PowerPointApp.Presentations.Add
'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Add(1, 12) '12 = ppLayoutBLANK
Dim targetBook As Workbook
Dim wsMain As Worksheet
Set targetBook = ThisWorkbook
Set wsMain = targetBook.Worksheets("Main Tab - Comp")
Dim currentCell As Range 'currentCell as range
Dim rgDV As Range
Dim DV_Cell As Range 'Excel.range not sure Excel is needed here
Dim rng As Range
Dim pvtTbl As PivotTable 'Where is this used?
Set DV_Cell = wsMain.Range("A2")
'********Note: this is an alternative for testing ***************
'Set rgDV = Application.Range(Mid$(DV_Cell.Validation.Formula1, 2)) 'so this returns a cell reference
Set rgDV = wsMain.Range("B2:B4")
'***************************************************************
For Each currentCell In rgDV.Cells
Debug.Print currentCell.Address
DV_Cell = currentCell
wsMain.Calculate 'Assume you now want a recalculation based on changing DV_Cell
With myPresentation
'Copy Range from Excel
Set rng = wsMain.Range("A3:AA52")
'Copy Excel Range
rng.Copy
Set mySlide = .Slides.Add(.Slides.Count + 1, 12) '12 = ppLayoutBLANK. The first number is the index
'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
'Set position:
myShape.Left = 0
myShape.Top = 0
End With
'Clear The Clipboard
Application.CutCopyMode = False
Next currentCell
'Presentation Save code goes here. Depending on whether presentation already existed or you created a new presentation
'closing/quiting code
PowerPointApp.Quit
Application.ScreenUpdating = True
End Sub
Private Function GetPPT() As Object
Dim PowerPointApp As Object
'Create an Instance of PowerPoint
On Error Resume Next
'Is PowerPoint already opened?
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
'Clear the error between errors
Err.Clear
'If PowerPoint is not already open then open PowerPoint
If PowerPointApp Is Nothing Then
Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
PowerPointApp.Visible = True
End If
On Error GoTo 0
Set GetPPT = PowerPointApp
End Function