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

将表从powerpoint文件导出到excel文件

1 个答案: