Select all Tables in power point slide - vba

Question

I am trying to create a macro which selects all the tables present in a slide in ppt using vba i tried but the macro is selecting the last table or the table created lastly
here is the code
Sub CheckCoOrdinates()
Dim pptPres As Presentation
Set pptPres = Application.ActivePresentation
Dim pptSlide As Slide
Dim pptShapes As Shape
For Each pptSlide In pptPres.Slides
For Each pptShapes In pptSlide.Shapes
If pptShapes.Type = msoTable Then
Dim i As Integer
For i = 1 To pptSlide.Shapes.Count
pptShapes.Select
pptShapes.Copy
Next
End If
Next
Next
how to create a macro for this

Answer 1

Instead of pptShapes.Select, use pptShapes.Select (False)
The default behavior of Select mimics clicking on a new shape ... the clicked shape is selected, replacing any previous selection. Adding the False parameter makes it behave more like Ctrl+clicking ... the newly selected shape is ADDED to the current selection.
That'll work on a per slide basis but you can't select shapes on multiple slides, so you're going to have to re-write your macro accordingly.
I suspect you'll be better off stepping through each slide, then through each shape on the slide and copy/pasting the tables one at a time.

Answer 2

Dim pptPres As Presentation
Set pptPres = Application.ActivePresentation
Dim xlApp As Object
Dim xlWorkBook As Object
Dim j As Integer
Dim r1 As String
j = 1
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWorkBook = xlApp.Workbooks.Open("D:\Book2.xlsx", True, False)
Dim pptSlide As Slide
Dim pptShapes As Shape
For Each pptSlide In pptPres.Slides
For Each pptShapes In pptSlide.Shapes
If pptShapes.Type = msoTable Then
Dim i As Integer
For i = 1 To pptSlide.Shapes.Count
pptSlide.Select
pptShapes.Select 'msoFalse
pptShapes.Copy
xlWorkBook.sheets(1).Activate
r1 = "A" + CStr(j)
xlWorkBook.sheets(1).Range(r1).PasteSpecial Paste:=xlPasteValues
j = j + 20
Next
End If
Next
Next
'xlWorkBook.Close SaveChanges:=True
Set xlApp = Nothing
Set xlWorkBook = Nothing