I wanted to do something that seemed simple enough:

1. Loop through all slides in the active presentation
2. Loop through the shapes in the slide
3. If it's a table and width is <410 then position it, make a duplicate and position duplicate (I should also be checking to see if there is another table on the slide but I couldnt get that to work)
4. If it's a table and with is >880 then simply position it.
5. Repeat until done.

The code I came up with goes into an infinite loop when duplicating and repositioning the new shape. I can't figure it out.

Help me Obi Wan

Thanks in advance

Sub test()

    Dim sld As Slide
    Dim shp As Shape
    Dim sr As Series
    Dim chrt As Chart

        For Each sld In ActivePresentation.Slides
            For Each shp In sld.Shapes

                If shp.HasTable Then
                
                    With shp
                        
                        MsgBox .Width
                        
                        If .Width < 410 Then
                        
                            MsgBox "<410"
                        
                            .Top = 170
                            .Left = 35
                            .Width = 409

                            .Duplicate

                            .Top = 170
                            .Left = 515
                            .Width = 409
                        
                        End If
                        
                        If .Width > 880 Then
                        
                        MsgBox ">880"
                        
                            .Top = 170
                            .Left = 35
                            .Width = 889
                        
                        End If

                End With
                
                End If
                
            Next shp
        Next sld
End Sub

CodePudding user response：

You want to avoid looping over sld.Shapes if you might be adding shapes to the slide within the loop.

One way to do that is to first collect the tables in a Collection and then loop over that:

Sub test()

    Dim sld As Slide
    Dim shp As Shape, shp2 As Shape
    Dim sr As Series
    Dim chrt As Chart, col As Collection

    For Each sld In ActivePresentation.Slides
        'first collect any existing table(s) on the slide
        Set col = New Collection
        For Each shp In sld.Shapes
            If shp.HasTable Then col.Add shp
        Next shp
        
        'check what was found
        If col.Count = 1 Then
            Set shp = col(1)
            If shp.Width < 410 Then
                shp.Top = 170
                shp.Left = 35
                shp.Width = 409
                Set shp2 = shp.Duplicate.Item(1) 'duplicate and get a reference to the new table
                shp2.Top = 170
                shp2.Left = 515
                shp2.Width = 409
            ElseIf shp.Width > 880 Then
                shp.Top = 170
                shp.Left = 35
                shp.Width = 889
            End If
        ElseIf col.Count > 1 Then
            '>1 table found - what to do here?
        End If
    Next sld
End Sub