How to setup a conversion from Excel Table to PowerPoint Presentation-CodePudding

I would like to create a presentation based on data sorted in rows:

That, in the PowerPoint, would appear as this

But I am having difficulties understanding the correct syntax to properly have this done inside PowerPoint, rather than the Excel where the data comes from: how to declare/deal with the range of cells that become each a slide and in each of them of how to fill the relative placeholder, or "transposed/cut" place in table. I have looked everywhere, the very few pages/articles I found are not clear and overall short of explanation. I am stuck at the very beginning of this as I don't know how to set up the variable range of cells or if it should be an array to split later in different ranges, I would know how to continue, once I understood how to link Excel to PowerPoint Layouts/Slides/Objects.

I know I have to set a counter for each step, i.e. on for the change in Section #, in in the Slide # etc., mostly I find not clear how to translate the different parts of the table in rows and then section of rows.

EDIT: With code I have come up so far, this was the most helpful resource I could find. However I have the problem I was mentioning before: I do I swap the row I have left to columns in the table? How do I change them in a Range? I referenced Excel for PowerPoint as from the original code, but the selection does no get recognized in POwerPoint (as said above, I would like to use it in PPT, not in Excel) . However, it works only in Excel, I have an error at For Each DataRow In DataRange.Rows variable not set when running as pptm. (reciprocal Libraries enabled in both programs).

From Excel, I can populate the title and the heading (so "AAA" and "aa") but I do not know how to progress in the cells, transposing the values for some columns and then restart.

Update: I added a variable for the the columns of the source, but I am not sure how to deal with it. I'm so close but I don't know how to finish it. I introduced the variable FirstRowToColumn as range (columns E to the Excel screenshot below, that would become the first column of the tabel in PowerPoint), but I don't know how to declare this and the others range and paste them into the table. Could someone please teach me this or point to the solution, am I at least close ?

Edit2: added, with which I would copy the range and paste transposed, but it says the area is different.

Edit3: I can paste, I have to fix the counter to have the table in each slide, but the question of how to transpose remains and on top of that how to write the values in the Powerpoint table.

Edit 4: I am trying a new way, by pasting in the Object placeholder id, but I saee nothing appearing in the table.


Sub General_Namer_For_Slides_And_Shapes()

Dim AnySlide As Slide
Dim AnyShape As Shape


Set AnySlide = Application.ActivePresentation.Slides(1)
    For Each AnyShape In AnySlide.Shapes
        Debug.Print "Application.ActivePresentation.Slides(1) AnySlide.Shapes AnyShape.Name " & AnyShape.Name & " AnyShape.Id "; AnyShape.Id  '''names of each shape and their id   '''removed " Slide " & AnySlide.SlideID&;
    Next
Debug.Print "ActivePresentation.Slides(1).CustomLayout.Name " & ActivePresentation.Slides(1).CustomLayout.Name & " ActivePresentation.Slides(1).CustomLayout.Index " & ActivePresentation.Slides(1).CustomLayout.Index&;
Debug.Print " There are " & ActivePresentation.SlideMaster.Design.SlideMaster.CustomLayouts(4).Shapes.Count & " shapes in the Layout slide (SlideMaster View)"
'Debug.Print "ActivePresentation.Designs(4).Name = " & ActivePresentation.Designs(1).SlideMaster.CustomLayouts(4); ""
'Debug.Print " ActivePresentation.Designs.Name" &  ActivePresentation.SlideMaster.Shapes.Placeholders. & ; ActivePresentation.Designs(4).Index; " & ActivePresentation.Designs(4).Index  "

End Sub


                        Set NewTable = sld.Shapes.AddTable(12, 4)

                        FirstRowToColumn.Cells.PasteSpecial Paste:=-4163, Transpose:=True

Sub LoopRowsSelectedXCLToPPT()

     Dim xlApp As Object
     Dim xlWorkBook As Object
     Dim xlSheet As Object

    Dim DataRange As Range 'used
    Dim DataRow As Range    'used
    Dim DataCol As Range    'used
    
    
    Dim PPTrng As Range  ''cloning here the above to use in PowerPoint
    Dim ShpRng As ShapeRange ''cloning here the data raw as range of shapes i could create later
    Dim ShpCll As Shape
    
    Dim AppPPT As PowerPoint.Application
    Dim Pres As PowerPoint.Presentation
    Dim sld As PowerPoint.Slide
        
    Dim AppXCL As Excel.Application 'repeated the same as above with Excel as argument
    Dim InputSheet As Excel.Worksheet
        
    Set AppPPT = GetObject(, "PowerPoint.Application")
    Set Pres = AppPPT.ActivePresentation
        
    Set AppXCL = GetObject(, "Excel.Application")
    Set InputSheet = AppXCL.ActiveSheet
    
   Dim RowCounter As Integer
   Dim ColCounter As Integer
   
   Dim iRow As Integer
   Dim iColumn As Integer
   
   Dim FirstRowToColumn As Range
   Dim SecondRowToColumn As Range
      
   RowCounter = 0
   ColCounter = 0
   
    Set DataRange = Selection
    
    For Each DataRow In DataRange.Rows
    
RowCounter = RowCounter   1

        Set sld = Pres.Slides.AddSlide(Pres.Slides.Count   1, Pres.SlideMaster.CustomLayouts(4))
        sld.Shapes.Title.TextFrame.TextRange.Text = DataRow.Cells(3, 3)
        sld.Shapes.Placeholders(4).TextFrame.TextRange.Text = DataRow.Cells(3, 4)
        
'                For Each DataCol In DataRange.Columns
    
                    ColCounter = ColCounter   1
                            
                            
                           Set FirstRowToColumn = DataRange.Range(Cells(RowCounter   1, 5), Cells(RowCounter   1, 10))
                         FirstRowToColumn.Copy

                        Set NewTable = sld.Shapes.AddTable(12, 4)
                sld.Shapes.Placeholders(4).TextFrame.TextRange.Text = FirstRowToColumn.Cells(1, 5)
                        
                        
'                            FirstRowToColumn.Cells(1, 10) =
'                    With sld.Shapes.Placeholders
'                       NewTable.Range(1,1)
'
'
'                    End With


'                    With sld.Shapes.Paste.SpecialPaste:=-4163, Transpose:=True

        
    Next DataRow

    
    Debug.Print RowCounter
    Debug.Print ColCounter
End Sub

CodePudding user response：

You may have to finesse the details but this works for me:

Sub LoopRowsSelectedXCLToPPT()
    
    Const TABLE_COLS As Long = 5 '# of columns in PPT tables
    Const BLOCK_SIZE As Long = 5
    
    Dim Datarange As Range, rw As Range, rng As Range, i As Long, col As Long
    Dim ppApp As PowerPoint.Application, pres As PowerPoint.Presentation
    Dim sld As PowerPoint.Slide, newTable As PowerPoint.Table
    
    On Error Resume Next
    Set ppApp = GetObject(, "PowerPoint.Application")
    Set pres = ppApp.ActivePresentation
    On Error GoTo 0
    
    If pres Is Nothing Then
        MsgBox "Destination presentation must be open in PowerPoint", vbCritical
        Exit Sub
    End If
    
    Set Datarange = Selection
    For Each rw In Datarange.Rows
        Set sld = pres.Slides.AddSlide(pres.Slides.Count   1, _
                                       pres.SlideMaster.CustomLayouts(2))
        
        Set newTable = sld.Shapes.AddTable(BLOCK_SIZE, TABLE_COLS).Table
        col = 0
        Set rng = rw.Cells(5).Resize(1, BLOCK_SIZE) 'first BLOCK_SIZE cells starting from Col E
        Do While Application.CountA(rng) > 0        'while have any data in `rng`
            col = col   1
            If col > TABLE_COLS Then Exit Do  'ran out of columns in the PPT table...
            For i = 1 To BLOCK_SIZE  'fill column # col
                newTable.Cell(i, col).Shape.TextFrame2.TextRange.Text = rng.Cells(i).Value
            Next i
            Set rng = rng.Offset(0, BLOCK_SIZE) 'next block of cells to the right
        Loop
    Next rw
    
End Sub