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

Question

我需要从 PowerPoint 演示文稿中的文本框中提取数据，并将它们放在 Excel 工作表中的相应单元格中。
我已经搜索但找不到合适的解决方法。
此代码用于打印幻灯片中的文本。我不明白如何在 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 幻灯片中循环遍历形状时要提到它通常是按照形状创建的顺序来的。因此，为了保持字段的正确顺序，您必须根据它们的位置(即顶部、左侧属性或根据演示文稿的任何其他标准)对它们进行排序。尝试

    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。