在VBA中从powerpoint文件中提取所有文本

在VBA中从powerpoint文件中提取所有文本,vba,text,powerpoint,strip,Vba,Text,Powerpoint,Strip,我有一个巨大的powerpoint文件集,我想从中提取所有文本,并将其全部合并到一个大文本文件中。每个源(PPT)文件都有多个页面(幻灯片)。我不在乎格式,只在乎文字 我可以通过PPT中的^a^C,然后是记事本中的^V,手动创建一个文件;然后在PPT中向下翻页,并在powerpoint中的每张幻灯片上重复。(太糟糕了,我不能只做^a就能抓取所有东西……然后我就可以使用sendkey复制/粘贴) 但是有很多这样的PPT,有不同数量的幻灯片 这似乎是一件普通的事情,但我在任何地方都找不到一个例子 有

我有一个巨大的powerpoint文件集,我想从中提取所有文本,并将其全部合并到一个大文本文件中。每个源(PPT)文件都有多个页面(幻灯片)。我不在乎格式,只在乎文字

我可以通过PPT中的^a^C,然后是记事本中的^V,手动创建一个文件;然后在PPT中向下翻页,并在powerpoint中的每张幻灯片上重复。(太糟糕了,我不能只做^a就能抓取所有东西……然后我就可以使用sendkey复制/粘贴)

但是有很多这样的PPT,有不同数量的幻灯片

这似乎是一件普通的事情,但我在任何地方都找不到一个例子


有人有这样做的示例代码吗?

这里有一些代码可以帮助您开始。这会将幻灯片中的所有文本转储到调试窗口。它不尝试格式化、分组或做任何事情,而只是转储

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

以下示例显示了基于上面给出的御宅族代码在文件列表中循环的代码:

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

我试试看,然后回来!酷。请注意,“调试”窗口可以容纳的文本数量有限。您可以将结果输出到.txt或其他文件,但仍然存在问题。设置PPT=CreateObject(“PowerPoint.Application”)PPT.Visible=True PPT.Presentations.Open filename:=src,只读:=True Set p=PPT.ActivePresentation For Each s In p.幻灯片For Each sh In s.形状如果是sh.HasTextFrame,那么如果是sh.TextFrame.HasText,那么打印#1,sh.TextFrame.TextRange.Text End If End If End If NextPowerpoint似乎打开了,但我看不到内容…当我只是复制/粘贴代码时,它工作正常,但我一次处理数百(可能1000)个这些文件。不确定如何在后续评论中格式化此内容。谢谢,要查看调试窗口,您需要在PowerPoint中打开VBE(Visual Basic编辑器)。然后打开即时窗口(我相信它是Ctrl+G)。但是,如果您想查看被踢出的内容,而不是
Debug.Print
,您也可以使用
MsgBox
。我会在一个小PPT上这样做,因为它会很快填满返回消息框中的大部分屏幕。但是,您是否从另一个软件中自动执行此操作?我这样问是因为你正在做
Set PPT=CreateObject(“PowerPoint.Application”)
,如果你在PowerPoint中使用VBE,你就不需要这样做了。付出了很大的努力。感谢您与社区分享您的最终解决方案,同时仍然接受御宅族的回答。