从PPT中提取文本并使用VBA将其粘贴到Excel中

Question

我需要从PowerPoint演示文稿的文本框中提取数据，并将其放在excel工作表的各个单元格中。我提供了两个样本图像参考，以作为最终结果的示例。我浏览了互联网上的每个站点，但似乎找不到合适的解决方法：（

我是VBA的初学者，在这项练习中我完全迷路了。像这样的代码只能帮助我从幻灯片中打印文本，但是我不明白如何在excel单元格中进行排列。请你们任何人帮我解决这个问题吗？

Dim oPApp As Object
Dim oSlide As Object
Dim oShape As Object

Set oPApp = GetObject(, "PowerPoint.Application")

For Each oSlide In oPApp.ActivePresentation.Slides
    For Each oShape In oSlide.Shapes

        If oShape.Type = 1 Or oShape.Type = 14 Then
            Debug.Print oShape.TextFrame.TextRange.Text
        End If

    Next oShape
Next oSlide

Set oPApp = Nothing

---

幻灯片示例（输入）：

工作表示例（输出）：

Answer 1

假设您希望通过Excel模块完成此操作（也可以通过PowerPoint模块完成此操作），我只是向您的代码中添加了一些代码和建议。但是，要在PowerPoint幻灯片中循环浏览形状时要提到它，通常按形状创建的顺序进行。因此，为了保持字段的正确顺序，您必须制定出某种方法来根据它们的位置对它们进行排序（即根据演示文稿的top，left属性或任何其他条件）。试试

    Dim oPApp As Object
    Dim oSlide As Object
    Dim oShape As Object

    Dim Rw, StCol, Col, Sht As Long
    Rw = 2     'Starting Row of Target excel data
    StCol = 1   'Starting Column of Target excel data
    Sht = 3   'Target Worksheet no.

    Set oPApp = GetObject(, "PowerPoint.Application")
    'It will only work for already opened active presentation
    'It can also be suugested that first create a powerpoint object and then open desired preesntation fron the path

    For Each oSlide In oPApp.ActivePresentation.Slides
    Col = StCol
        For Each oShape In oSlide.Shapes
            If oShape.Type = 1 Or oShape.Type = 14 Then
            '    Debug.Print oShape.TextFrame.TextRange.Text
            'Next line was added for putting the data into excel sheet
            ThisWorkbook.Sheets(Sht).Cells(Rw, Col).Value = 
 oShape.TextFrame.TextRange.Text
            End If
        Col = Col + 1
        Next oShape
    Rw = Rw + 1
    Next oSlide

    Set oPApp = Nothing

但是请注意，msoTextBox类型为17，类型14为msoPlaceholder。