在VBA中提取PowerPoint文件中的所有文本

Question

我有一大堆PPT文件，想要提取所有的文本并将其整合到一个大的文本文件中。每个源（PPT）文件都有多个页面（幻灯片）。我不关心格式-只关心文字。

我可以通过在PPT中使用^ A ^ C，然后在记事本中使用^ V手动完成此操作；然后在PPT中向下翻页，并为幻灯片中的每一页重复此过程。（太遗憾了，我无法使用^ A来全选……然后我就可以使用sendkey来复制/粘贴）

但是有很多这些具有不同幻灯片数量的PPT文件。

这似乎是一件常见的事情，但我找不到任何示例。

是否有人有样例代码可以做到这一点？

- elbillaf

Answer 1

这里有一些代码可供参考。它会将幻灯片中的所有文本转储到调试窗口。它不会尝试进行格式化、分组或任何其他操作，只是简单地转储。

Sub GetAllText()
Dim p As Presentation: Set p = ActivePresentation
Dim s As Slide
Dim sh As Shape
For Each s In p.Slides
    For Each sh In s.Shapes
        If sh.HasTextFrame Then
            If sh.TextFrame.HasText Then
                Debug.Print sh.TextFrame.TextRange.Text
            End If
        End If
    Next
Next
End Sub

- Todd Main

---

我会尝试并回来的！ - elbillaf

很好。请注意，调试窗口可以容纳的文本数量有限。不过你可以将结果输出到 .txt 或其他文件中。 - Todd Main

仍然有问题。 Set PPT = CreateObject("PowerPoint.Application") PPT.Visible = True PPT.Presentations.Open filename:=src, ReadOnly:=True Set p = PPT.ActivePresentation 对于每个s In p.Slides 对于每个sh In s.Shapes 如果sh.HasTextFrame Then 如果sh.TextFrame.HasText Then Print #1, sh.TextFrame.TextRange.Text End If End If 下一个 下一个 - elbillaf

Powerpoint似乎已经打开，但我看不到内容...当我只是复制/粘贴您的代码时，它可以正常工作，但我一次要处理数百个（也许是1000个）这些文件。不确定如何在后续评论中格式化此内容。谢谢，tff - elbillaf

要查看调试窗口，您需要在PowerPoint中打开VBE（Visual Basic Editor）。然后打开即时窗口（我认为是Ctrl + G）。但是，如果您想查看被踢出的内容，而不是使用“Debug.Print”，您也可以使用“MsgBox”。我会在小型PPT上执行此操作，因为它将快速填满返回的消息框中的大部分屏幕。不过，您是从其他软件自动化执行此操作吗？我问这个问题是因为您正在执行“Set PPT = CreateObject（“PowerPoint.Application”）”，如果您正在使用PowerPoint中的VBE，则不需要执行此操作。 - Todd Main

问题已解决。在文件之间使用PP.ActivePresentation.Close而不是PPT.quit。太感谢了，兄弟。 - elbillaf

Answer 2

以下示例展示了基于Otaku上面给出的代码循环遍历文件列表的代码：

Sub test_click2()

Dim thePath As String
Dim src As String
Dim dst As String
Dim PPT As PowerPoint.Application
Dim p As PowerPoint.Presentation
Dim s As Slide
Dim sh As PowerPoint.Shape
Dim i As Integer
Dim f(10) As String

f(1) = "abc.pptx"
f(2) = "def.pptx"
f(3) = "ghi.pptx"

thePath = "C:\Work\Text parsing PPT\"

For i = 1 To 3
  src = thePath & f(i)
  dst = thePath & f(i) & ".txt"

  On Error Resume Next
  Kill dst
  Open dst For Output As #1
    Set PPT = CreateObject("PowerPoint.Application")
    PPT.Activate
    PPT.Visible = True
    'PPT.WindowState = ppWindowMinimized
    PPT.Presentations.Open filename:=src, ReadOnly:=True
    For Each s In PPT.ActivePresentation.Slides
        For Each sh In s.Shapes
            If sh.HasTextFrame Then
                If sh.TextFrame.HasText Then
                    Debug.Print sh.TextFrame.TextRange.Text
                End If
            End If
        Next
    Next
    PPT.ActivePresentation.Close
  Close #1
Next i
Set PPT = Nothing

End Sub

- elbillaf

---

非常棒的努力。感谢您与社区共享最终解决方案，同时仍然接受了宅男的回答。 - froeschli