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