VBA code for data in PowerPoint table, not objects

H

hobbes_

New Member
Joined
Jun 29, 2012
Messages
29
Hi guys,

I have this VBA code which I use for transferring data from my data sheet to slides in PowerPoint - it works fine.

However in PowerPoint I'm currently forced to transfer data to "text-objects" which is a bit of a drag because I'm used to working in a table in Powerpoint when organizing data.

Therefore my question is how to edit my VBA code so I can transfer data to a table in PowerPoint instead of an object.

Thanks. :)
Here's the VBA code:


Code: 
Sub TDPTest()
    Dim shtStudent As Worksheet
    Dim strMedarbejder As String
    Dim strTitel As String
    Dim strFastholdelse As String
    Dim lngRow As Long
    Dim objPPT As Object
    Dim objPres As Object
    Dim objSld As Object
    Dim objShp As Object
    
    Set shtStudent = Worksheets("Ark1")
        
    Set objPPT = CreateObject("Powerpoint.Application")
    objPPT.Visible = True
    Set objPres = objPPT.presentations.Open(ThisWorkbook.Path & "\JBX_test.ppt")
    objPres.SaveAs ThisWorkbook.Path & "\TDPTest.ppt"
    
    lngRow = 2
    Do While shtStudent.Cells(lngRow, 2) <> ""
        
        strMedarbejder = shtStudent.Cells(lngRow, 1)
        strTitel = shtStudent.Cells(lngRow, 2)
        strFastholdelse = shtStudent.Cells(lngRow, 3)
                       
        Set objSld = objPres.slides(1).Duplicate
        For Each objShp In objSld.Shapes
            If objShp.HasTextFrame Then
                If objShp.TextFrame.HasText Then
                    objShp.TextFrame.TextRange.Replace "<Medarbejder>", strMedarbejder
                    objShp.TextFrame.TextRange.Replace "<Titel>", strTitel
                    objShp.TextFrame.TextRange.Replace "<Fastholdelse>", strFastholdelse
                End If
            End If
        Next
        lngRow = lngRow + 1
    Loop
    objPres.slides(1).Delete
    objPres.Save
    objPres.Close
    
End Sub
 
Last edited:
Sort by date Sort by votes
Hi Hobbes
Here at my workplace I can't access RapidShare, will download the files at home and be back soon...

Have a nice weekend.
 
Upvote 0

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Hi Hobbes</SPAN></SPAN>

Please test the macro below. A few points to note:</SPAN></SPAN>


  • The PowerPoint table has 26 fields and the source data had only 25 because "X5” was missing. I inserted it and now the source list goes from column A through Z.</SPAN></SPAN></SPAN>
  • If text at “X1" is too lengthy it won’t fit properly in the table.</SPAN></SPAN></SPAN>
  • Check if records with several lines, like Weaknesses, are displaying correctly in the PP table.
</SPAN>
</SPAN></SPAN>
Code: 
Option Explicit:    Option Base 1
Sub Hobbes()
    Dim shtStudent As Worksheet, objPPT As Object, objPres As Object, _
    nrows%, i%, j%, LastRow%, PProw, PPcol
    
    ' index for PowerPoint table, rows and columns
    PProw = Array(6, 3, 4, 5, 6, 3, 4, 5, 6, 8, 9, 11, 12, 13, 10, _
    13, 13, 15, 16, 17, 18, 18, 18, 20, 20, 20)
    PPcol = Array(2, 4, 4, 4, 4, 6, 6, 6, 6, 2, 2, 2, 2, 2, 4, 4, 6, 2, 2, 2, 2, 4, 6, 2, 4, 6)
    
    Set shtStudent = Worksheets("Ark1")
    Set objPPT = CreateObject("Powerpoint.Application")
    objPPT.Visible = True
    Set objPres = objPPT.presentations.Open(ThisWorkbook.Path & "\JBX_Test16jul.ppt")
    objPres.SaveAs ThisWorkbook.Path & "\TDPFinal.ppt"
    LastRow = shtStudent.Range("b" & Rows.Count).End(xlUp).Row
    
    For i = 1 To LastRow - 2            ' first line of source data is a header
        objPres.Slides(1).Duplicate     ' create the necessary number of slides
    Next
        
    For i = 1 To LastRow - 1            ' each source data row
        For j = 1 To 26                 ' each source data column
            objPres.Slides(i).Shapes(1).Table.Cell(PProw(j), PPcol(j)).Shape.TextFrame.TextRange.Text = _
            shtStudent.Cells(i + 1, j).Value
        Next
    Next
    
    objPres.Save
    objPres.Close
    Set objPres = Nothing               ' clean up
    Set objPPT = Nothing
End Sub
 
Upvote 0
This is great - thanks so much :)

If we use the first row in the speadsheet as an example, I think the X5 correction is causing the data to be pulled out of order, because the 'X5' cell in PP is 'Meet Expectations' which should be in the next cell, 'Performance & Potential'. This causes the data in the 'Strengths' cell to be pulled back to the 'Since Last Review' cell.

I think it's just a small correction, right?
 
Upvote 0
I've been looking at it and trying different thing with the rows and columns. There doesn't seem to be a mistake in the code, but it behaves counterintuitive with 12,2 and 13,2.

I renamed the data in X1-X5 to 1-5 and to me it looks like the problem is with X3, which is the only data I can't get into the PP table. When executed it seems the X3 data is overruled by the X5 data?
 
Upvote 0
Hi Hobbes

I inserted a new column at the source sheet because you have 26 cells to fill at the PowerPoint table and the sheet had only 25 columns of data.
So, “meet expectations” is under Performance Rating and will go in the table at (10, 4). I’m not sure if you fully understood how the code works; see that, taking row 2 as an example:

- The first action is to place the contents of cell (2, 1), which is A2, into PP table at (6, 2), which is the Name field.
- The last action is to place the contents of cell (2, 26), which is Z2, into PP table at (20, 6), which corresponds to Mobility Comments.

Below I post pictures to help clarify this. If you prefer, please post an updated version of both source sheet and PP table and I’ll tweak the code myself.

The source sheet, note the columns identification:
Ark1

*ABCDEFGHIJKLMN
*
*

<colgroup><col style="font-weight:bold; width:30px; "><col style="width:109px;"><col style="width:81px;"><col style="width:37px;"><col style="width:74px;"><col style="width:104px;"><col style="width:166px;"><col style="width:150px;"><col style="width:110px;"><col style="width:131px;"><col style="width:112px;"><col style="width:28px;"><col style="width:28px;"><col style="width:28px;"><col style="width:28px;"></colgroup><tbody>
[TD="bgcolor: #cacaca, align: center"]1[/TD]
[TD="bgcolor: #c0c0c0, align: center"]Name[/TD]
[TD="bgcolor: #c0c0c0, align: center"]Education[/TD]
[TD="bgcolor: #c0c0c0, align: center"]Age[/TD]
[TD="bgcolor: #c0c0c0, align: center"]Seniority[/TD]
[TD="bgcolor: #c0c0c0, align: center"]Mercer index[/TD]
[TD="bgcolor: #c0c0c0, align: center"]Title[/TD]
[TD="bgcolor: #c0c0c0, align: center"]Reporting manager[/TD]
[TD="bgcolor: #c0c0c0, align: center"]Direct reports[/TD]
[TD="bgcolor: #c0c0c0, align: center"]Total employees[/TD]
[TD="bgcolor: #c0c0c0, align: center"]1[/TD]
[TD="bgcolor: #c0c0c0, align: center"]2[/TD]
[TD="bgcolor: #c0c0c0, align: center"]3[/TD]
[TD="bgcolor: #c0c0c0, align: center"]4[/TD]
[TD="bgcolor: #c0c0c0, align: center"]5[/TD]

[TD="bgcolor: #cacaca, align: center"]2[/TD]
[TD="align: center"]Doe, Jane *JAD[/TD]
[TD="align: center"]Engineer[/TD]
[TD="align: center"]42[/TD]
[TD="align: center"]6,5[/TD]
[TD="align: center"]180[/TD]
[TD="align: center"]Department Manager, VAS[/TD]
[TD="align: center"]Smith, Simon *SIS[/TD]
[TD="align: center"]6[/TD]
[TD="align: center"]18[/TD]
[TD="align: center"]-[/TD]
[TD="align: center"]-[/TD]
[TD="align: center"]-[/TD]
[TD="align: center"]-[/TD]

[TD="bgcolor: #cacaca, align: center"]3[/TD]
[TD="align: center"]Doe, John *JODO[/TD]
[TD="align: center"]Engineer[/TD]
[TD="align: center"]38,5[/TD]
[TD="align: center"]8 years[/TD]
[TD="align: center"]90[/TD]
[TD="align: center"]System administrator[/TD]
[TD="align: center"]Smith, Simon *SIS[/TD]
[TD="align: center"]-[/TD]
[TD="align: center"]-[/TD]
[TD="align: center"]Have been ill for a long time but seems to be back at full force.[/TD]
[TD="align: center"]-[/TD]
[TD="align: center"]-[/TD]
[TD="align: center"]-[/TD]

</tbody>


Excel tables to the web >> Excel Jeanie HTML 4


Continuing:
Ark1

*OPQRSTUVWXYZ
*

<colgroup><col style="font-weight:bold; width:30px; "><col style="width:155px;"><col style="width:126px;"><col style="width:137px;"><col style="width:98px;"><col style="width:101px;"><col style="width:113px;"><col style="width:90px;"><col style="width:187px;"><col style="width:221px;"><col style="width:138px;"><col style="width:171px;"><col style="width:152px;"></colgroup><tbody>
[TD="bgcolor: #cacaca, align: center"]1[/TD]
[TD="bgcolor: #c0c0c0, align: center"]Performance Rating[/TD]
[TD="bgcolor: #c0c0c0, align: center"]Potential Rating[/TD]
[TD="bgcolor: #c0c0c0, align: center"]Since last Review[/TD]
[TD="bgcolor: #c0c0c0, align: center"]Strengths[/TD]
[TD="bgcolor: #c0c0c0, align: center"]Weaknesses[/TD]
[TD="bgcolor: #c0c0c0, align: center"]Opportunities [/TD]
[TD="bgcolor: #c0c0c0, align: center"]Limitations[/TD]
[TD="bgcolor: #c0c0c0, align: center"]Key Development Areas[/TD]
[TD="bgcolor: #c0c0c0, align: center"]Development Plan Proposals[/TD]
[TD="bgcolor: #c0c0c0, align: center"]Career Aspiration[/TD]
[TD="bgcolor: #c0c0c0, align: center"]Internationally Mobile[/TD]
[TD="bgcolor: #c0c0c0, align: center"]Mobility Comments[/TD]

[TD="bgcolor: #cacaca, align: center"]2[/TD]
[TD="align: center"]Meet Expectations[/TD]
[TD="align: center"]High[/TD]
[TD="align: center"]Jane has done well, but is expected to be able to do even better. She has taken the feedback to heart and has evolved in the right direction.[/TD]
[TD="align: center"]Structure
Leadership
Communication[/TD]
[TD="align: center"]Energy
Numbers
Relationsships
Ambition[/TD]
[TD="align: center"]Education
Network[/TD]
[TD="align: center"]Confidence[/TD]
[TD="align: center"]Jane will continue to work on her weaknesses and continue the positive development she has been through the past 9 months.[/TD]
[TD="align: center"]Energy
Numbers
Relationsships
Ambition[/TD]
[TD="align: center"]-[/TD]
[TD="align: center"]Yes[/TD]
[TD="align: center"]A position in Norway might be appropriate for her.[/TD]

[TD="bgcolor: #cacaca, align: center"]3[/TD]
[TD="align: center"]Below Expectations[/TD]
[TD="align: center"]Low[/TD]
[TD="align: center"]-[/TD]
[TD="align: center"]-[/TD]
[TD="align: center"]-[/TD]
[TD="align: center"]-[/TD]
[TD="align: center"]-[/TD]
[TD="align: center"]-[/TD]
[TD="align: center"]-[/TD]

[TD="align: center"]No[/TD]
[TD="align: center"]Asia[/TD]

</tbody>


Excel tables to the web >> Excel Jeanie HTML 4




The mapped PowerPoint table:
PPtable.JPG
 
Upvote 0
Hi Hobbes

You have some wrong indexes on the macro you posted. The code below will work along with the PowerPoint template also posted:

Code: 
Sub Hobbes()
    Dim shtStudent As Worksheet, objPPT As Object, objPres As Object, _
    nrows%, i%, j%, LastRow%, PProw, PPcol
    
    ' index for PowerPoint table, rows and columns
    PProw = Array(6, 3, 4, 5, 6, 3, 4, 5, 6, 8, 9, 11, 12, 13, 10, _
    13, 13, 15, 16, 17, 18, 18, 18, 20, 20, 20)
    PPcol = Array(2, 4, 4, 4, 4, 6, 6, 6, 6, 2, 2, 2, 2, 2, 4, 4, 6, 2, 2, 2, 2, 4, 6, 2, 4, 6)
    
    Set shtStudent = Worksheets("Ark1")
    Set objPPT = CreateObject("Powerpoint.Application")
    objPPT.Visible = True
    Set objPres = objPPT.presentations.Open(ThisWorkbook.Path & "\JBX_Test26jul.ppt")
    objPres.SaveAs ThisWorkbook.Path & "\TDPFinal.ppt"
    LastRow = shtStudent.Range("b" & Rows.Count).End(xlUp).Row
    
    For i = 1 To LastRow - 2            ' first line of source data is a header
        objPres.Slides(1).Duplicate     ' create the necessary number of slides
    Next
        
    For i = 1 To LastRow - 1            ' each source data row
        For j = 1 To 26                 ' each source data column
            objPres.Slides(i).Shapes(1).Table.Cell(PProw(j), PPcol(j)).Shape.TextFrame.TextRange.Text = _
            shtStudent.Cells(i + 1, j).Value
        Next
    Next
    
    objPres.Save
    objPres.Close
    Set objPres = Nothing               ' clean up
    Set objPPT = Nothing
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

O
  • Question Question
Using VBA to create certificates in Powerpoint from excel cell values
Replies
6
Views
4K
Macropod
Macropod
M
  • Question Question
VBA code to replace contents in a Powerpoint table using Excel data
Replies
2
Views
26K
MitchelK
M
I
  • Question Question
Exporting table data from Powerpoint to Excel using VBA - Getting Error 438: Object doesn't support this property...
Replies
3
Views
13K
jsotola
J

Forum statistics

Threads
1,223,908
Messages
6,175,307
Members
452,633
Latest member
DougMo

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top