PPT VBA遍历幻灯片形状复制表格出现无限循环问题求助

问题根因 #

你代码出现无限循环的核心原因是：For Each shp In sld.Shapes 属于动态遍历形状集合，调用.Duplicate生成的新表格会自动被加入到当前幻灯片的Shapes集合中。新表格宽度为409，命中<410的判断逻辑，会被再次遍历到并触发复制操作，无限重复就形成了死循环。

另外你原有代码还存在逻辑错误：复制表格后设置的位置属性，仍然作用于原表格，而非新生成的副本，不符合你“原表格放左侧、副本放右侧”的需求。

修复方案 #

提前把当前幻灯片的所有表格收集到固定集合中，再遍历这个固定集合处理，不会读取到后续新增的副本，同时单独捕获复制生成的副本对象，单独设置其属性即可，修复后代码如下：

Sub 批量处理演示文稿表格()
    Dim sld As Slide
    Dim shp As Shape
    Dim 待处理表格 As Collection
    Dim 表格副本 As Shape
    
    For Each sld In ActivePresentation.Slides
        ' 提前收集当前页所有原始表格，避免新增形状干扰遍历
        Set 待处理表格 = New Collection
        For Each shp In sld.Shapes
            If shp.HasTable Then
                待处理表格.Add shp
            End If
        Next
        
        ' 遍历固定的待处理表格集合
        For Each shp In 待处理表格
            With shp
                If .Width < 410 Then
                    ' 设置原表格属性
                    .Top = 170
                    .Left = 35
                    .Width = 409
                    
                    ' 捕获副本并设置副本属性
                    Set 表格副本 = .Duplicate
                    表格副本.Top = 170
                    表格副本.Left = 515
                    表格副本.Width = 409
                    
                ElseIf .Width > 880 Then
                    ' 仅调整大表格位置尺寸
                    .Top = 170
                    .Left = 35
                    .Width = 889
                End If
            End With
        Next
    Next sld
End Sub

如果后续需要补充“校验幻灯片上是否已有其他表格”的逻辑，直接在第一步收集待处理表格的环节增加判断条件即可。

内容的提问来源于stack exchange，提问作者juanbolas