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

我需要从PowerPoint演示文稿的文本框中提取数据，并将它们放在Excel工作表的相应单元格中

我已经找过了，但找不到合适的工作

此代码用于打印幻灯片中的文本。我不明白如何在Excel单元格中排列它

Dim oPApp作为对象
将奥斯陆变暗为对象
作为对象的模糊oShape
设置oPApp=GetObject（，“PowerPoint.Application”）
对于oPApp.ActivePresentation.Slides中的每个oSlide
适用于奥斯陆的每种oShape。形状
如果oShape.Type=1或oShape.Type=14，则
调试。打印oShape.TextFrame.TextRange.Text
如果结束
下一个奥沙佩
下一个奥斯陆
设置oPApp=Nothing

幻灯片示例（输入）：

工作表（输出）示例：

---

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

---

但是，有一点需要注意：msoTextBox类型为17，msoPlaceholder类型为14

如果您的帖子中的代码示例对您有用，那么您接下来要探索的是Office自动化，即创建Excel

应用程序

对象并打开工作簿，然后设置工作表并将数据添加到单元格中。查看和。您还需要测试14型形状的Placeholder Format.ContainedType。这将告诉您占位符是否包含文本或其他内容。如果是其他内容，则可能没有文本框可用于提取文本，尝试提取文本将抛出错误。@SteveRindsberg他不是已经这样做了吗

如果oShape.Type=1或oShape.Type=14，那么

非常感谢大家@Ahmed代码运行得非常好（再次感谢！）。我想从各位专家那里得到一条建议——目前代码提取msoTextBox类型17中的所有内容，并将其放在excel列B或C中（显然，字段a、B、C、D包含在一个文本框中），但我希望字段a在一列中提取，字段B在另一列中提取，依此类推。你认为我应该在VBA中使用“查找”，然后提取字段A和B之间的字符，然后将其导出到excel，还是这样会使代码过于复杂，我应该使用excel公式来实现这一点？@Marucciboy2否。类型14（即占位符）对象可以保存文本、图表、图片、视频、smartart、，等等。尝试插入新的标题+内容幻灯片，单击内容占位符的图表图标，然后执行调试。打印ActiveWindow.Selection.ShapeRange（1）。Textframe，Textrange.Text。您将收到一条错误消息。@user10434129文本框中的文本是什么样子的？如果字段由某个唯一字符分隔，VBA的SPLIT命令将为您执行提升操作。

    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