'How to clone and align selected counted shapes to table by index, skipping one column

After the table with the number of column equal to the shapes selected is created, I would like to realign each of them (the shapes) respectively to the relative column (here the third, fifth etc.) and duplicate them in the following slides that are not using a Layout named Section. However I am not able to declare this, could someone help please?

Option Explicit


Sub NavigatorX()


Dim nCounter As Long
Dim oSlide As Slide
Dim oSlides As Slides
Set oSlides = ActivePresentation.Slides

Dim oShapeNavigator As Shape

Dim Shapesarray() As Shape                                      
ReDim Shapesarray(1 To ActiveWindow.Selection.ShapeRange.Count) - 1
Dim V As Long   

Dim iIcon As Shape


For V = 1 To ActiveWindow.Selection.ShapeRange.Count                    
        Set Shapesarray(V) = ActiveWindow.Selection.ShapeRange(V)
        
Next V                                                             
     
    Debug.Print V

For Each oSlide In oSlides
    If oSlide.CustomLayout.Name = "Section Header" Then
        nCounter = nCounter + 1

            Set oShapeNavigator = oSlide.Shapes.AddTable(1, V, Left:=10, Top:=10, Width:=MasterTitle.Width * 2 / 3, Height:=2)

           CellLeft = oShapeNavigator.Table.Cell(iRow, iColumn).Shape.Left
           CellTop = oShapeNavigator.Table.Cell(iRow, iColumn).Shape.Top
           CellWidth = oShapeNavigator.Table.Cell(iRow, iColumn).Shape.Width
           CellHeight = oShapeNavigator.Table.Cell(iRow, iColumn).Shape.Height
                      Debug.Print CellWidth
                      Debug.Print CellHeight
                
           Shp_Cntr = CellLeft + CellWidth / 2
           Shp_Mid = CellTop + CellHeight / 2

Next

   With oShapeNavigator.Table      '@@ TABLE @@
       For iRow = 1 To .Rows.Count
       For iColumn = 1 To .Columns.Count Step 2


              For Each iIcon In Shapesarray ' Here is where I am having problems figuring out how to do it
                     If V = nCounter Then

                     Icon.Left = Shp_Cntr - CellHeight
                     Icon.Top = Shp_Mid - CellHeight
                     Icon.Width = CellHeight
                     Icon.Height = CellHeight


               Next
'

      Next iColumn
      Next iRow
Next oSlide

End Sub

I tried the below also (Shp_Cntr and the rest to be defined, but thats's not the issue at the moment as I get Only one shape moving):

Currently it's like below, it's copying but pasting all in the same slide
...
For V = 1 To ActiveWindow.Selection.ShapeRange.Count - 1                   'Set Selected Array of Shapes
        Set Shapesarray(V) = ActiveWindow.Selection.ShapeRange(V)
              Set iIcon = Shapesarray(V)
    Next V         
...


      With oShapeNavigator.Table      '@@ TABLE @@
        For iRow = 1 To .Rows.Count
            For iColumn = 1 To .Columns.Count Step 2
                For V = LBound(Shapesarray) To UBound(Shapesarray) - 1
                
                                   CellLeft = oShapeNavigator.Table.Cell(iRow, iColumn).Shape.Left
                                   CellTop = oShapeNavigator.Table.Cell(iRow, iColumn).Shape.Top
                                   CellWidth = oShapeNavigator.Table.Cell(iRow, iColumn).Shape.Width
                                   CellHeight = oShapeNavigator.Table.Cell(iRow, iColumn).Shape.Height
                                   Debug.Print CellWidth
                                   Debug.Print CellHeight
                
                                   Shp_Cntr = CellLeft + CellWidth / 2
                                   Shp_Mid = CellTop + CellHeight / 2
                                                
                
                            With iIcon.Duplicate
                                iIcon.Left = Shp_Cntr - CellHeight
                                iIcon.Top = Shp_Mid - CellHeight
                                iIcon.Width = CellHeight
                                iIcon.Height = CellHeight
                            End With
'                         End If
                Next V

             Next iColumn
         Next iRow
    End With

But only one shape (with three selected, the second) gets cloned and only in the first slide. Also, I noticed there is a massive amount of shapes created, here (Copy paste shape by using VBA in PowerPoint) they mention to set a new collection, but it did not help as I am not able to integrate it.


Currently it's like below but it's pasting in the first slide

For V = LBound(Shapesarray) To UBound(Shapesarray) - 1


               Set iIcon = ActiveWindow.Selection.ShapeRange(V)
               
               
'                For Each Icon In ShapeRange
                   
                                   CellLeft = oShapeNavigator.Table.Cell(iRow, iColumn).Shape.Left
                                   CellTop = oShapeNavigator.Table.Cell(iRow, iColumn).Shape.Top
                                   CellWidth = oShapeNavigator.Table.Cell(iRow, iColumn).Shape.Width
                                   CellHeight = oShapeNavigator.Table.Cell(iRow, iColumn).Shape.Height
                                   Debug.Print CellWidth
                                   Debug.Print CellHeight

                                   Shp_Cntr = CellLeft + CellWidth / 2
                                   Shp_Mid = CellTop + CellHeight / 2

                                iIcon.Left = Shp_Cntr - (CellHeight * IconRatio / 2)
                                iIcon.Top = Shp_Mid - (CellHeight * IconRatio / 2)
                                iIcon.Width = CellHeight * IconRatio
                                iIcon.Height = CellHeight * IconRatio
                                iIcon.ZOrder msoBringToFront
                                iIcon.Fill.ForeColor.RGB = RGB(0, 0, 0)
                                iIcon.Line.Weight = 0#
                                iIcon.Line.Visible = msoFalse
                                iIcon.LockAspectRatio = msoTrue
'                        Next

'                For nCounter = 1 To oSlides.Count
                        iIcon.Copy
                    For nCounter = 1 To oSlides.Count
'
'                        oSlide.Shapes.Paste
                           End If
'                        Next
    Next V

Looping through I can see If I remove the iIcon.Copy part it moves the selected icons all the way to the last column together, so it seems it should deselect the shapes one by one first.



Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source