Tout le texte d'extraire un fichier powerpoint en VBA

Question

J'ai un énorme ensemble de fichiers powerpoint dont je veux extraire tout le texte et juste amalgamer le tout dans un seul gros fichier texte. Chaque fichier source (PPT) a plusieurs pages (diapositives). Je ne me soucie pas de mise en forme -. Seulement les mots

Je pourrais le faire manuellement avec un fichier de seulement ^ A ^ C en PPT, suivie ^ V dans le bloc-notes; puis la page vers le bas dans le PPT, et répéter pour chaque diapositive dans le powerpoint. (Dommage que je ne peux pas juste un ^ A qui saisirait TOUT ... alors je pourrais utiliser sendkey copier / coller)

Mais il y a plusieurs centaines de ces différents numéros avec PPTs de diapositives.

Il semble que ce serait une chose commune à vouloir faire, mais je ne peux pas trouver un exemple partout.

Est-ce que quelqu'un a un exemple de code pour le faire?

Answer 1

Voici un code pour vous aider à démarrer. Ce dépotoirs tout le texte dans les diapositives à la fenêtre de débogage. Il ne cherche pas au format, groupe ou faire autre chose qu'une simple décharge.

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

L'exemple suivant montre code à boucle à travers une liste de fichiers basé sur le code de Otaku donnée ci-dessus:

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