L'extraction de l'ensemble du texte à partir d'un fichier powerpoint en VBA

J'ai un énorme ensemble de fichiers powerpoint à partir de laquelle je veux extraire tout le texte et juste forfaitaire à tous en un seul gros fichier texte. Chaque source (PPT) fichier comporte plusieurs pages (diapositives). Je ne m'inquiète pas sur la mise en forme - seulement les mots.

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

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

Il semble que ce serait une chose commune à faire, mais je ne peux pas trouver un exemple de n'importe où.

Quelqu'un aurait-il un exemple de code pour faire cela?

OriginalL'auteur elbillaf | 2011-01-12

  1. 3

    Voici un code pour obtenir vous avez commencé. Cette dumps tout le texte dans les diapositives de la fenêtre de débogage. Il n'essaie pas de format, de groupe ou de faire autre chose que de simplement le jeter.

    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
    Je vais l'essayer et de revenir!
    Cool. Notez que la fenêtre de débogage a un peu de texte qu'il peut contenir. Vous pouvez frapper les résultats à un .txt ou autre fichier.
    Ça y est! Merci!
    Encore problème. Ensemble PPT = CreateObject("PowerPoint.L'Application") PPT.Visible = True PPT.Les présentations.Open filename:=src, ReadOnly:=True Set p = PPT.ActivePresentation Pour Chaque s Dans p.Les diapositives Pour Chaque poisson Dans s.Des formes Si sh.HasTextFrame Alors Si sh.TextFrame.HasText Puis Print #1, sh.TextFrame.TextRange.Texte Fin Si Fin Si Prochaine Prochaine
    Powerpoint semble s'ouvrir, mais je ne peux pas voir les choses...quand je viens de copier / coller votre code, il fonctionne très bien, mais je suis pour le traitement des centaines (peut-être 1000s) de ces fichiers à la fois. Pas sûr de savoir comment formater cette chose dans les commentaires de suivi. merci,la fft

    OriginalL'auteur Todd Main

  2. 1

    L'exemple suivant montre le code d'une boucle sur une liste de fichiers sur la base d'Otaku code donné 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
    Un grand effort. Merci pour le partage de votre solution finale avec la communauté, tout en acceptant les otaku réponse.

    OriginalL'auteur elbillaf