How to extract all text from a PPT presentation

[John Svendsen]

Hi All,

I need to extract all texts from PPT presentations to pre-process for
translations.
I've built a macro, but it does not work - can someone please look at it and
hopefully shed some light on what is wrong?
Thanks a lot! JS
--------------------------
Sub ReadText()
'
Dim sFirst As String
Dim sLast As TextRange
Open "c:\abc.txt" For Output As #1
'Print #1, "test"
Do While Not EOF(1)
For Each sld In Application.ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasTextFrame Then
' MsgBox TextRange.Text
' trying one way...
TextFrame.TextRange.selstart = 0
TextFrame.TextRange.sellength = TextFrame.textlength
TextFrame.TextRange.Copy
sFirst = GetFromClipboard
Print #1, sFirst
' trying another way...
sLast = TextRange.Text
Set sLast = TextFrame.TextRange.Text
sLast = ActiveWindow.Selection.TextRange
Print #1, sLast
End If
Next
Next
Loop
Close #1
End Sub

 

[Bill Dilworth]

Personally, I'd avoid the clipboard. Try this:

===Begin======
Sub TextOut()
Dim sld As Integer
Dim shp As Integer

Open "c:\TextOut.txt" For Output As #1

For sld = 1 To ActivePresentation.Slides.Count
With ActivePresentation.Slides(sld)
For shp = 1 To .Shapes.Count
With .Shapes(shp)
If .HasTextFrame Then
Print #1, .TextFrame.TextRange.Text
End If
End With
Next shp
End With
Next sld

Close #1

End Sub
======End========

Bill Dilworth, Microsoft PPT MVP
===============
Please spend a few minutes checking vestprog2@
out www.pptfaq.com This link will yahoo.
answer most of our questions, before com
you think to ask them.

Change org to com to defuse anti-spam,
ant-virus, anti-nuisance misdirection.
..
..

 

[Shyam Pillai]

John,

Sub ReadText()
Dim shp As Shape
Dim sld As Slide

Open "c:\abc.txt" For Output As #1
On Error Resume Next
For Each sld In Application.ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasTextFrame Then
If shp.TextFrame.HasText Then
Print #1, shp.TextFrame.TextRange
End If
End If
Next
Next
Close #1
End Sub

Regards
Shyam Pillai

http://www.mvps.org/skp