将 Powerpoint 上 Table 的文本导入到 Excel

Question

我目前正在编写使用 VBA 的代码，它将自动将位于 Powerpoint 幻灯片中 tables 中的文本作为文本或 [=] 导入 Excel 39=].

幻灯片看起来像这样：

*** 根据 TechnoDabbler 协助更新代码

    Public Sub CopySlideShapesText()

    ' Update the PowerPoint file name
    Const cPowerPointName = "test.pptx"

    Dim vPowerPoint As PowerPoint.Application
    Dim vPresentation As PowerPoint.Presentation
    Dim vSlide As PowerPoint.Slide
    Dim vPowerpointShape As PowerPoint.Shape
    Dim vSheet As Worksheet
    Dim vRowCounter As Long

    ' Open the powerpoint presentation
    Set vPowerPoint = New PowerPoint.Application
    Set vPresentation = vPowerPoint.Presentations.Open(cPowerPointName)

    ' Write the slide info onto the active excel sheet
    Set vSheet = ActiveSheet

    ' Loop through each of the slides
    vRowCounter = 1
    For Each vSlide In vPresentation.Slides

        ' Loop through each shape on the slide
        For Each vPowerpointShape In vSlide.Shapes

            ' If shape isn't a table ... copy the text
            If Not vPowerpointShape.HasTable Then
                vPowerpointShape.Copy
                vSheet.Range("A" & vRowCounter) = vPowerpointShape.TextFrame2.TextRange.Text
                vRowCounter = vRowCounter + 1
            Else
                vPowerpointShape.Copy
                vSheet.Range("A" & vRowCounter).Select
                vSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False
                vRowCounter = vRowCounter + vPowerpointShape.Table.Rows.Count
            End If
        Next
    Next

    vPresentation.Close
    vPowerPoint.Quit

End Sub

更新

显示错误

Answer 1

@Excelsson ... a table 是一种形状，但需要稍微区别对待；您可以将其作为一个完整的实体粘贴...或者您可以遍历一个形状（包含 table）内的行和列。这是一个循环遍历所有幻灯片的代码示例，然后是幻灯片上的所有形状，如果它是一个简单的形状，那么它会复制到文本中，或者如果形状包含 tables 那么它会复制总数table 并继续下一个形状（考虑到 table 中的行数）：

Option Explicit

' ---> ADD REFERENCE TO MICROSOFT POWERPOINT OBJECT LIBRARY

Public Sub CopySlideShapesText()

    ' Update the PowerPoint file name
    Const cPowerPointName = "test.pptx"

    Dim vPowerPoint As PowerPoint.Application
    Dim vPresentation As PowerPoint.Presentation
    Dim vSlide As PowerPoint.Slide
    Dim vPowerpointShape As PowerPoint.Shape
    Dim vSheet As Worksheet
    Dim vRowCounter As Long

    ' Open the powerpoint presentation
    Set vPowerPoint = New PowerPoint.Application
    Set vPresentation = vPowerPoint.Presentations.Open(cPowerPointName)

    ' Write the slide info onto the active excel sheet
    Set vSheet = ActiveSheet

    ' Loop through each of the slides
    vRowCounter = 1
    For Each vSlide In vPresentation.Slides

        ' Loop through each shape on the slide
        For Each vPowerpointShape In vSlide.Shapes

            ' If shape isn't a table ... copy the text
            If Not vPowerpointShape.HasTable Then
                If vPowerpointShape.TextFrame2.HasText Then
                    vPowerpointShape.Copy
                    vSheet.Range("A" & vRowCounter) = vPowerpointShape.TextFrame2.TextRange.Text
                    vRowCounter = vRowCounter + 1
                End If
            Else
                vPowerpointShape.Copy
                vSheet.Range("A" & vRowCounter).Select
                vSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False
                vRowCounter = vRowCounter + vPowerpointShape.Table.Rows.Count
            End If
        Next
    Next

    vPresentation.Close
    vPowerPoint.Quit

End Sub

它产生的一个例子：

Powerpoint 幻灯片：

Excel 输出：

如果你想遍历 table 的行和列（或者更准确地说是包含 table 的形状），你可以从这个答案中改编代码：

干杯

将 Powerpoint 上 Table 的文本导入到 Excel

Importing Text from Table on Powerpoint to Excel

excel

powerpoint

vba