Извлечение всего текста из файла PowerPoint в VBA

Question

У меня есть огромный набор файлов PowerPoint, из которых я хочу извлечь весь текст и просто выложить его в один большой текстовый файл. Каждый файл источника (PPT) имеет несколько страниц (слайдов). Меня не волнует форматирование - только слова.

Я мог бы сделать это вручную с помощью файла только^A^C в PPT, а затем^V в блокноте; затем прокрутите страницу вниз в PPT и повторите для каждого слайда в PowerPoint. (Слишком плохо, я не могу просто сделать a A, который бы захватил ВСЕ ... тогда я мог бы использовать sendkey для копирования/вставки)

Но есть много сотен этих PPT с различным количеством слайдов.

Кажется, что это было бы обычным делом, но я не могу найти пример где-нибудь.

У кого-нибудь есть пример кода для этого?

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 

Answer 2

В следующем примере показан код Переберите список файлов на основе кода отаку в приведенный выше:

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