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

Question

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
to
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

Answer 1

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