Extract text from ppt table and paste into excel using VBA

[NaWin55]

I have a challenge to create a macro that extracts the data(Text) from each table and paste the text into a excel sheet , this i can do but i need to position the text in excel spread sheet how the tables in ppt are positions
for ex: if first ppt table co-ordinate values(left = 16 and top = 16) then the text copied from the first table should be pasted into excel at same co ordinate values(left = 16 and top = 12) in excel

here are the images for reference
Ppt slide

this code extracts and pastes the data from tables but it positions the text one below another like this

Option Explicit

Sub GetTableNames()

Dim pptpres As Presentation
Set pptpres = ActivePresentation

Dim pptSlide As Slide
Set pptSlide = Application.ActiveWindow.View.Slide

Dim pptShapes As Shape, pptTable As Table

Dim XL As Object, WS As Object
Dim arr As Variant, nextTablePlace As Integer, cnt As Integer

Set XL = CreateObject("Excel.Application")
With XL.Workbooks.Add
Set WS = .Worksheets(1)
End With

nextTablePlace = 1 ' to output first table content into Worksheet

For Each pptSlide In pptpres.Slides
For Each pptShapes In pptSlide.Shapes
If pptShapes.HasTable Then
cnt = cnt + 1
Set pptTable = pptShapes.Table
' WS.Cells(nextTablePlace, 1) = "Table #: " & cnt ' caption for each table
nextTablePlace = nextTablePlace + 1
ReDim arr(1 To pptTable.Rows.Count, 1 To pptTable.Columns.Count) ' resize array to table dimensions
Dim rr As Integer
Dim cc As Integer
For rr = 1 To pptTable.Rows.Count
For cc = 1 To pptTable.Columns.Count
arr(rr, cc) = pptTable.Cell(rr, cc).Shape.TextFrame.TextRange.Text 'get text from each cell into array
Next
Next


WS.Cells(nextTablePlace, 1).Resize(pptTable.Rows.Count, pptTable.Columns.Count) = arr

' to next place with gap
nextTablePlace = nextTablePlace + pptTable.Rows.Count + 2
End If
Next
Next
XL.Visible = True

End Sub
excel shhet

i can get the co-ordinate values of tables from ppt but i don't know to use co ordinate values of the ppt tables and use them to position the text in excel

i need help

 

[SkipVought]

i can get the co-ordinate values of tables from ppt but i don't know to use co ordinate values of the ppt tables and use them to position the text in excel

Is your objective to get DATA into Excel or to get a pretty picture into Excel?

I also notice that you have no HEADINGS in your tables, which is unusual???

By using the CAMERA feature, you could position x-number of "pictures" of x-number of tables anywhere you like via VBA, with the caveat that your TOP property and LEFT property will be from the TOP and LEFT of the Excel grid rather than the Window. But I think there's probably a way that one of our super members could help you with that.

So the process can use the code you currently have. There will be another blank sheet that new code will place the "pictures" on. In addition, you'll need to record and store the TOP-LEFT coordinates for each table for the next process.

Here's what you need to do next...
Read and execute FAQ68-7518.
When you figure out how to use the CAMERA feature, turn on your macro recorder and record taking a "picture" of ONE table and positioning the "picture" on the blank sheet. Turn off the macro recorder and post your recorded code to get assistance in customizing for x-number of tables

I must say that it is very, VERY strange that a Power Point presentation would be a reliable source for data in a workbook. I have, on more than one occasion, used data from Excel to link to a presentation. But this is crazy! Sounds to me like a school project. I should have asked you what the business case is for this effort.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein

 

[NaWin55]

Hi SkipVought thanks for the replay

this is actually a company project that i am working on
Yes there are headings for each table
Here it is

Each table contains operation number 1,2 3 and goes on

i need to position the text from first operation and second operation tables in excel according to co-ordinate values (positions of ppt tables) in ppt presentation

i am really struggling to position the tables
if it is possible to do some manual process with automation that's ok
the macro need not to be 100% automated

 

[SkipVought]

I've worked for several companies that used automated work instructions for machine operators and assembly. None of them used Power Point as a source!

1) Did you get the CAMERA icon loaded into your Quick Access Toolbar as suggested?

2) Have you recorded the process I outlined previously?

3) Please post your recorded code.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein

 

[NaWin55]

Ok recorded the code

i placed like this

here is the recorded code

Sub CameraMacro()
'
' CameraMacro Macro
'

'
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Application.CutCopyMode = False
Selection.FillDown
Range("A2:C4").Select
Selection.Copy
ActiveSheet.Shapes.AddShape(, 240.75, 82.5, 72#, 72#).Select
ActiveSheet.Shapes.Range(Array("Picture 1")).Select
Application.CutCopyMode = False
Selection.ShapeRange.IncrementLeft 6.75
Selection.ShapeRange.IncrementTop -9.75
Range("A8:C10").Select
Selection.Copy
ActiveSheet.Shapes.AddShape(, 345.75, 190.5, 72#, 72#).Select
ActiveSheet.Shapes.Range(Array("Picture 2")).Select
Application.CutCopyMode = False
Selection.ShapeRange.IncrementLeft -97.5
Selection.ShapeRange.IncrementTop -9.75
Selection.ShapeRange.IncrementLeft 3
Selection.ShapeRange.IncrementLeft 180
Selection.ShapeRange.IncrementTop -106.5
Range("A14:C16").Select
Selection.Copy
ActiveSheet.Shapes.AddShape(, 261#, 188.25, 72#, 72#).Select
ActiveSheet.Shapes.Range(Array("Picture 3")).Select
Application.CutCopyMode = False
Range("H18").Select
ActiveSheet.Shapes.Range(Array("Picture 3")).Select
Selection.ShapeRange.IncrementLeft -10.5
Selection.ShapeRange.IncrementTop -2.25
Range("A20:C22").Select
Selection.Copy
ActiveSheet.Shapes.AddShape(, 441.75, 187.5, 72#, 72#).Select
ActiveSheet.Shapes.Range(Array("Picture 4")).Select
Application.CutCopyMode = False
Selection.ShapeRange.IncrementLeft -9
Selection.ShapeRange.IncrementTop -4.5
Range("M19").Select
ChDir "C:\Users\NaWin\Desktop\Project"
ActiveWorkbook.SaveAs Filename:="C:\Users\User15\Desktop\Project\Book2.xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

 

[SkipVought]

I've got egg on my face. I thought that I had set up CAMERA pictures in VBA, but I can't get the picture to run successfully.

However, you ought to be able to use the CAMERA feature to do what you want.

Use the CAMERA icon to place each picture on any sheet by
1) selecting each table,
2) click CAMERA,
3) select position on any sheet

If you can set up a table containing the TOP and LEFT values that you need for each picture in the order that they are placed on the sheet, then you don't need to fuss about the placement. We can run a procedure to fix the placement as long as your pictures are all on ONE sheet.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein

 

[NaWin55]

I don't want to place picture in excel sheet i want to position the text only not like picture if i use camera and place picture i cant be able to edit the text
so i only want to copy the text and position it based on the co-ordinate values of ppt table positrons

 

[SkipVought]

Change the Table linked to the picture. Your changes will be reflected in the linked picture.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein

 

[NaWin55]

Change the Table linked to the picture. Your changes will be reflected in the linked picture

I don't know how to that



this camera method is not working
not a valid solution to my question

i will try some other methods
if you find any way to solve this please add that

thanks

 

[SkipVought]

I don't know how to that [/code]

You simply go to any table linked to a picture and change a value, just like you would in any other table.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein

 

[remeng]

Hi,

Can you use the insert Excel spreadsheet option in PP and link that direct to the Excel worksheet in the associated file?

INSERT > TABLE > EXCEL SPREADSHEET​

In PP you'd just need to hit the Refresh All button that comes up when you double click on the inserted Excel sheet under the DATA tab.

Double click inside the table > DATA > Refresh All​

This can be linked to Tables inside the Excel workbook too.

Mike