Экспорт таблиц из файла PowerPoint в файл excel

Question

У меня есть файл powerpoint с большим количеством таблиц. Таблицы имеют одинаковые столбцы. Как я могу автоматически экспортировать эти таблицы в один файл excel?

Answer 1

Sub DataTransfer() 

Dim shp As Shape, i%, j% 

' Dim colCount As Integer 
' Dim rowCount As Integer 


Dim rowNum As Integer 
Dim rng As Object 

Set rng = GetObject(, "Excel.Application").Range("a1") ' start at top of worksheet 

    For i = 1 To ActivePresentation.Slides.Count 

    For Each shp In ActivePresentation.Slides(i).Shapes 

     If shp.HasTable Then 

      With shp.Table 
colCount = .Columns.Count 
rowCount = .Rows.Count 

       For rowNum = 0 To .Rows.Count - 1 

        For j = 0 To 4 
         rng.Offset(rowNum, j).Value = (.Cell(rowNum + 1, j + 1).Shape.TextFrame.TextRange) 
        Next j 

        rng.Offset(rowNum, 4).Interior.Color = (.Cell(rowNum + 1, 5).Shape.TextFrame.TextRange) 

       Next rowNum 

       Set rng = rng.Offset(rowNum + 1) 

      End With 
     End If 
    Next shp 
Next i