B
Baher
i have the below code. Only problem is it gives me slide1 title text and
slide168 title text. if i replace
"& oSlide.Shapes.Title.TextFrame.TextRange.Text _"
with
& oSlide.Shapes("Rectangle 2").TextFrame.TextRange.Text _
it gives me all the stuff on any slide with a group type or shape of
"Rectangle 2". thats about the extent to which i know how this code
works...thanks!
**********************code starts here
Sub GatherTitles()
On Error GoTo ErrorHandler
Dim oSlide As Slide
Dim strTitles As String
Dim strFilename As String
Dim intFileNum As Integer
Dim PathSep As String
If ActivePresentation.Path = "" Then
MsgBox "Please save the presentation then try again"
Exit Sub
End If
#If Mac Then
PathSep = ":"
#Else
PathSep = "\"
#End If
On Error Resume Next ' in case there's no title placeholder on the slide
For Each oSlide In ActiveWindow.Presentation.Slides
strTitles = strTitles _
& "Slide: " _
& CStr(oSlide.SlideIndex) & vbCrLf _
& oSlide.Shapes.Title.TextFrame.TextRange.Text _
& vbCrLf & vbCrLf
'& oSlide.Shapes.Title.TextFrame.TextRange.Text
Next oSlide
On Error GoTo ErrorHandler
intFileNum = FreeFile
' PC-Centricity Alert!
' This assumes that the file has a .PPT extension and strips it off to make
the text file name.
strFilename = ActivePresentation.Path _
& PathSep _
& Mid$(ActivePresentation.Name, 1, Len(ActivePresentation.Name) - 4) _
& "_Titles.TXT"
Open strFilename For Output As intFileNum
Print #intFileNum, strTitles
NormalExit:
Close intFileNum
Exit Sub
ErrorHandler:
MsgBox Err.Description
Resume NormalExit
End Sub
slide168 title text. if i replace
"& oSlide.Shapes.Title.TextFrame.TextRange.Text _"
with
& oSlide.Shapes("Rectangle 2").TextFrame.TextRange.Text _
it gives me all the stuff on any slide with a group type or shape of
"Rectangle 2". thats about the extent to which i know how this code
works...thanks!
**********************code starts here
Sub GatherTitles()
On Error GoTo ErrorHandler
Dim oSlide As Slide
Dim strTitles As String
Dim strFilename As String
Dim intFileNum As Integer
Dim PathSep As String
If ActivePresentation.Path = "" Then
MsgBox "Please save the presentation then try again"
Exit Sub
End If
#If Mac Then
PathSep = ":"
#Else
PathSep = "\"
#End If
On Error Resume Next ' in case there's no title placeholder on the slide
For Each oSlide In ActiveWindow.Presentation.Slides
strTitles = strTitles _
& "Slide: " _
& CStr(oSlide.SlideIndex) & vbCrLf _
& oSlide.Shapes.Title.TextFrame.TextRange.Text _
& vbCrLf & vbCrLf
'& oSlide.Shapes.Title.TextFrame.TextRange.Text
Next oSlide
On Error GoTo ErrorHandler
intFileNum = FreeFile
' PC-Centricity Alert!
' This assumes that the file has a .PPT extension and strips it off to make
the text file name.
strFilename = ActivePresentation.Path _
& PathSep _
& Mid$(ActivePresentation.Name, 1, Len(ActivePresentation.Name) - 4) _
& "_Titles.TXT"
Open strFilename For Output As intFileNum
Print #intFileNum, strTitles
NormalExit:
Close intFileNum
Exit Sub
ErrorHandler:
MsgBox Err.Description
Resume NormalExit
End Sub