Solved excel VBA finds value from table in powerpoint

AlwaysWillingToLearn February 1, 2016 at 04:52:10

Here is some code that will 1) Go to the last slide of your presentation 2) Look at the first table in the last slide 3) Get the value from the second column and last row 4) display the value in the debug window Change the path in the code to your presentation. If this works then we can look at ways of 'feeding' this multiple file paths to open and read the table cell text Sub GetTableText() Dim mySlide As Object Dim oPA As Object Dim strTemplate As String Dim TableText As String strTemplate = "C:\Presentation.pptx" Set oPA = CreateObject("Powerpoint.application") oPA.Visible = True oPA.Presentations.Open strTemplate Err_PPT: If Err <> 0 Then MsgBox Err.Description Err.Clear Resume Next End If Set mySlide = oPA.ActivePresentation.Slides oPA.ActivePresentation.Slides(mySlide.Count).Select With oPA.ActivePresentation.Slides(mySlide.Count).Shapes(1).Table For i = 1 To .Rows.Count Next i End With TableText = oPA.ActivePresentation.Slides(3).Shapes(1).Table.Cell(i - 1, 2).Shape.TextFrame.TextRange Debug.Print TableText End Sub message edited by AlwaysWillingToLearn

Thankyou . But since I have a lot of pptx files to check, is there a way not to open the file each time I want to get the value inside the table ?

AlwaysWillingToLearn February 1, 2016 at 07:10:56

Hi, there is a way to get the value from each table within each powerpoint presentation. However you will have to open each file, but this processess can be hidden so the user does not see it happening. my first question before we progress however is, did the above code work in terms of returning the value within the table from the last slide? please run this on a couple of presentation, changing the file path as you go, and make a note of the desired output with the actual output to validate the codes performance. Once you have done that we can make changes to the code to allow for multiple files with a hideen process.

AlwaysWillingToLearn February 1, 2016 at 07:32:13

Here is some new code that will loop through multiple pptx files and output the cell values into the debug\immediate window... The only issue i have at the moment is that, if i try to hide the process i get an error, i will look into this. What you will need to do is 1) In column A of sheet 1 put enter the names of the presentation files (i have assumed they are all in the same folder) Default path For example 'C:\' A 1 presentation1 2 Presentation2 3 Presentation3 The code will then build a string using each filename as below C:\Presentation1.pptx C:\Presentation2.pptx C:\Presentation3.pptx It will then grab the text from each table. Note you do not need to add the file extention, this will be done by the code. All you need to do, is edit the code with the root path to where your presentations are held strTemplate = "C:\" and in column A enter the names of each presentation. Then run the code...... Sub GetTableText() Dim mySlide As Object Dim oPA As Object Dim strTemplate As String Dim TableText As String Dim iFileName As String Dim FileToOpen As String Dim URange Dim LRange Dim Bcell As Range Set URange = Sheet1.Range("A1") Set LRange = Sheet1.Range("A" & Rows.Count).End(xlUp) strTemplate = "C:\" If Right(strTemplate, 1) <> "\" Then strTemplate = strTemplate & "\" End If For Each Bcell In Range(URange, LRange) FileToOpen = strTemplate & Bcell & ".pptx" Set oPA = CreateObject("Powerpoint.application") oPA.Visible = msoTrue oPA.presentations.Open FileToOpen Err_PPT: If Err <> 0 Then MsgBox Err.Description Err.Clear Resume Next End If Set mySlide = oPA.ActivePresentation.Slides 'oPA.ActivePresentation.Slides(mySlide.Count).Select With oPA.ActivePresentation.Slides(mySlide.Count).Shapes(1).Table For i = 1 To .Rows.Count Next i End With TableText = oPA.ActivePresentation.Slides(3).Shapes(1).Table.Cell(i - 1, 2).Shape.TextFrame.TextRange Debug.Print TableText oPA.ActivePresentation.Close Next Bcell End Sub

The first code worked perfectly with minor adjustments. Now I just need to hide the process because I have an other program that will loop through the first program for each file.

AlwaysWillingToLearn February 2, 2016 at 01:50:30

Try this code, it will perform the same task as the first but invisible.. Sub GetTableText() Dim mySlide As Object Dim oPA As Object Dim strTemplate As String Dim TableText As String strTemplate = "C:\Template.pptx" Set oPA = CreateObject("Powerpoint.application") 'oPA.Visible = False oPA.Presentations.Open strTemplate, WithWindow:=msoFalse Err_PPT: If Err <> 0 Then MsgBox Err.Description Err.Clear Resume Next End If Set mySlide = oPA.Presentations(1).Slides 'oPA.ActivePresentation.Slides(mySlide.Count).Select With oPA.Presentations(1).Slides(mySlide.Count).Shapes(1).Table For i = 1 To .Rows.Count Next i End With TableText = oPA.Presentations(1).Slides(3).Shapes(1).Table.Cell(i - 1, 2).Shape.TextFrame.TextRange Debug.Print TableText oPA.Presentations(1).Close End Sub message edited by AlwaysWillingToLearn

AlwaysWillingToLearn February 3, 2016 at 01:40:34

✔ Best Answer

There was a small bug in the code so i have updated it. Sub GetTableText() Dim mySlide As Object Dim oPA As Object Dim strTemplate As String Dim TableText As String strTemplate = "C:\Template.pptx" Set oPA = CreateObject("Powerpoint.application") oPA.Presentations.Open strTemplate, WithWindow:=msoFalse Set mySlide = oPA.Presentations(1).Slides With oPA.Presentations(1).Slides(mySlide.Count).Shapes(1).Table For i = 1 To .Rows.Count Next i End With TableText = oPA.Presentations(1).Slides(mySlide.Count).Shapes(1).Table.Cell(i - 1, 2).Shape.TextFrame.TextRange Debug.Print TableText oPA.Presentations(1).Close End Sub message edited by AlwaysWillingToLearn

Hi so your code works fine but I seem to have run into a problem with mine. The présentations I am going through dont seem to have the same number of shapes on the last slide. One presentation might have the table set on shape 2, an other on shape 4. Right now if the presentation has the table on shape 4 and I call shapes(1), a vba error code apears and stops me dead. Is there a way to ignore the error, so I can change "shapes(1)" to "shapes(s)" and itterate "s" from 1 to until it finds the right shape with the table inside it ? thank you soo much

AlwaysWillingToLearn February 4, 2016 at 00:39:26

There are multiple things we could do, such as 1) ignore errors and move on, we could even record on which file the error was reported 2) this would be my preference Go through each shape on the last slide and perform some checks, this is where we need to understand what commonalities the tables you want the data from have and what the other tables you dont want data from have. For example if you had three shapes on the last slide and two of the tables had the word 'Mouse" in it somewhere, we know we can ignore these tables and pick the value from the remaing table as long as the word 'Mouse' does not appear on it. or if we know that the words you want will either be "Cat" "Dog" "Rat" or "Shoe" we can once again go through each shape, check if the word exists and return it. It is not always easy to stop the execution of code and amend it, then continue from where it failed, there are far better ways to make your code more robust as per point 2. Have a think and perhaps you can send me a couple of the presentations to look at over email? i can PM you my email address if you like. Please note that i will be on training for the next couple of days and will have very limited access to a PC.

AlwaysWillingToLearn February 4, 2016 at 05:27:24

Ok so i had a few minutes to play, the following code will 1) Go to the last slide 2) itterate through all the shapes on that slide and find the shape which has a table within it 3) Return the text from the specified cells of that table Sub GetTableText() Dim mySlide As Object Dim oPA As Object Dim strTemplate As String Dim TableText As String Dim ShapeCount As Integer ShapeCount = 0 strTemplate = "C:\Template.pptx" Set oPA = CreateObject("Powerpoint.application") oPA.Presentations.Open strTemplate, WithWindow:=msoFalse Set mySlide = oPA.Presentations(1).Slides With oPA.Presentations(1).Slides(mySlide.Count).Shapes For ShapeCount = 1 To .Count If .Item(ShapeCount).HasTable Then Exit For End If Next End With With oPA.Presentations(1).Slides(mySlide.Count).Shapes(ShapeCount).Table For i = 1 To .Rows.Count Next i End With TableText = oPA.Presentations(1).Slides(mySlide.Count).Shapes(ShapeCount).Table.Cell(i - 1, 2).Shape.TextFrame.TextRange Debug.Print TableText oPA.Presentations(1).Close End Sub message edited by AlwaysWillingToLearn