-----Original Message-----
That'd do it.
Sub DoLots()
Dim oPres as Presentation
For Each oPres in Presentations
' use the code from the link here but
' work with oPres instead of ActivePresentation
Next oPres
End Sub
You might also want to parse the .PPT off of
oPres.Fullname and append .TXT to
create a file for each presentation instead of having to split them up in Word.
--
Steve Rindsberg, PPT MVP
PPT FAQ:
www.pptfaq.com
PPTools:
www.pptools.com
================================================
Featured Presenter, PowerPoint Live 2004
October 10-13, San Diego, CA
www.PowerPointLive.com
================================================
.
Great minds think alike...
I went home and played with the code, coming up with the
following:
Sub ExportText()
Attribute ExportText.VB_Description = "Export text in
slides to plain text file"
'
'Original macro from Kris Lander
'Modified by Steve Rindsberg
'Modified by Allen N. Humphries to work with all open
presentations
'
Dim oPres As Presentation
Dim oPress As Presentations
Dim oSlides As Slides
Dim oSld As Slide 'Slide Object
Dim oShp As Shape 'Shape Object
Dim FileNum As Integer
Dim iFile As Integer 'File handle for output
Dim PathSep As String
Dim Response As Integer
#If Mac Then
PathSep = ":"
#Else
PathSep = "\"
#End If
Set oPress = Presentations
iFile = FreeFile 'Get a free file number
FileNum = FreeFile
For Each oPres In oPress 'Loop thru each presentation
'Open output file
'NOTE: errors here if file hasn't been saved
Open oPres.Path & PathSep & oPres.Name & ".txt" For Output
As FileNum
Print #iFile, UCase(Left(oPres.Name, Len(oPres.Name) - 4))
& vbCrLf
'Set oPres = ActivePresentation
Set oSlides = oPres.Slides
For Each oSld In oSlides 'Loop thru each slide
For Each oShp In oSld.Shapes 'Loop thru each shape on slide
'Check to see if shape has a text frame and text
If oShp.HasTextFrame And oShp.TextFrame.HasText Then
If oShp.Type = msoPlaceholder Then
Select Case oShp.PlaceholderFormat.Type
Case Is = ppPlaceholderTitle, ppPlaceholderCenterTitle
Print #iFile, "Title:" & vbTab &
oShp.TextFrame.TextRange & vbCrLf
Case Is = ppPlaceholderBody
Print #iFile, "Body:" & vbTab &
oShp.TextFrame.TextRange & vbCrLf
Case Is = ppPlaceholderSubtitle
Print #iFile, "SubTitle:" & vbTab &
oShp.TextFrame.TextRange & vbCrLf
Case Else
Print #iFile, "Other Placeholder:" & vbTab &
oShp.TextFrame.TextRange & vbCrLf
End Select
Else
Print #iFile, oShp.TextFrame.TextRange & vbCrLf
End If ' msoPlaceholder
End If ' Has text frame/Has text
Next oShp
Next oSld
Close #iFile 'Close output file
Next oPres
Response = MsgBox("Text files completed", , "Export text")
End Sub
It operates on any open presentation.
It puts the presentation file name as the first line in
the text file.
It creates a separate text file for each presentation
It removes .ppt and appends .txt
It adds a carriage return/line feed after each shape for
readability.
It displays a simple alert box when complete.
I would not have had a clue how to start it. With your
help, I now have a program that does exactly what I needed
it to do.
Many thanks!
