Estrazione tutto il testo da un file PowerPoint in VBA
-
10-10-2019 - |
Domanda
Ho un enorme insieme di file PowerPoint da cui vogliamo estrarre tutto il testo e proprio grumo tutto in un unico file di testo grande. Ogni file sorgente (PPT) ha più pagine (diapositive). Non mi interessa sulla formattazione -. Solo le parole
ho potuto farlo manualmente con un file semplicemente ^ A ^ C in PPT, seguita da ^ V nel blocco note; quindi la pagina verso il basso nel PPT, e ripetere per ogni diapositiva in PowerPoint. (Peccato che non si può semplicemente fare un ^ A che avrebbe afferrare TUTTO ... quindi potrei usare sendKey per copiare / incollare)
Ma ci sono molte centinaia di questi PPT con un diverso numero di diapositive.
Sembra che questo sarebbe una cosa comune a voler fare, ma non riesco a trovare un esempio da nessuna parte.
Qualcuno ha il codice di esempio per fare questo?
Soluzione
Ecco un po 'di codice per iniziare. Questo discariche tutto il testo nelle diapositive alla finestra di debug. Non provare a formattare, gruppo o fare qualcosa di diverso solo discarica.
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
Altri suggerimenti
Il seguente codice di esempio mostra per scorrere l'elenco dei file in base al codice di Otaku dato sopra:
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