E
Elke Thone
I'm using a macro from PPTtools to export all text on my slide to a text
file in Microsoft PowerPoint 2000.
Now I would like to combine this marco with another one of PPTtools, namely
to export notes to this same text file.
The problem is that I don't know any VB, so I have no clue as to how to
combine the two.
Here's the macro that I'm using now:
Sub ExportText()
Dim oSld As Slide 'Slide Object
Dim oShp As Shape 'Shape Object
Dim iFile As Integer 'File handle for output
Dim sSlideOutputFolder As String
Dim sPreText As String
Dim s As Integer
'zet hier het pad en de tekst voor de nummering juist
sSlideOutputFolder = "L:\scrap\"
sPreText = "Fext"
iFile = FreeFile 'Get a free file number
For Each oSld In ActivePresentation.Slides 'Loop thru each slide
'Open output file
Open sSlideOutputFolder & sPreText & Format(oSld.SlideIndex, "00") & ".txt"
For Output As iFile
s = 1
'ungroup alle items op de slide
Do Until s = 4
For Each oShp In oSld.Shapes 'Loop thru each shape on Slide
If oShp.Type = msoGroup Or oShp.Type = msoEmbeddedOLEObject Or oShp.Type =
msoLinkedOLEObject Or oShp.Type = msoTable Then
oShp.Ungroup
End If
Next oShp
s = s + 1
Loop
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
Print #iFile, oShp.TextFrame.TextRange
End If
Next oShp
'Close output file
Close #iFile
Next oSld
End Sub
And here's the macro that I would like to incorporate in the one above:
Sub ExportNotesText()
Dim oSlides As Slides
Dim oSl As Slide
Dim oSh As Shape
Dim strNotesText As String
Dim strFileName As String
Dim intFileNum As Integer
Dim lngReturn As Long
' Get a filename to store the collected text
strFileName = InputBox("Enter the full path and name of file to extract
notes text to", "Output file?")
' did user cancel?
If strFileName = "" Then
Exit Sub
End If
' is the path valid? crude but effective test: try to create the file.
intFileNum = FreeFile()
On Error Resume Next
Open strFileName For Output As intFileNum
If Err.Number <> 0 Then ' we have a problem
MsgBox "Couldn't create the file: " & strFileName & vbCrLf _
& "Please try again."
Exit Sub
End If
Close #intFileNum ' temporarily
' Get the notes text
Set oSlides = ActivePresentation.Slides
For Each oSl In oSlides
For Each oSh In oSl.NotesPage.Shapes
If oSh.PlaceholderFormat.Type = ppPlaceholderBody Then
If oSh.HasTextFrame Then
If oSh.TextFrame.HasText Then
strNotesText = strNotesText & "Slide: " & CStr(oSl.SlideNumber) & vbCrLf _
& oSh.TextFrame.TextRange.Text & vbCrLf & vbCrLf
End If
End If
End If
Next oSh
Next oSl
' now write the text to file
Open strFileName For Output As intFileNum
Print #intFileNum, strNotesText
Close #intFileNum
' show what we've done
lngReturn = Shell("NOTEPAD.EXE " & strFileName, vbNormalFocus)
End Sub
Thanks for any help,
Elke
file in Microsoft PowerPoint 2000.
Now I would like to combine this marco with another one of PPTtools, namely
to export notes to this same text file.
The problem is that I don't know any VB, so I have no clue as to how to
combine the two.
Here's the macro that I'm using now:
Sub ExportText()
Dim oSld As Slide 'Slide Object
Dim oShp As Shape 'Shape Object
Dim iFile As Integer 'File handle for output
Dim sSlideOutputFolder As String
Dim sPreText As String
Dim s As Integer
'zet hier het pad en de tekst voor de nummering juist
sSlideOutputFolder = "L:\scrap\"
sPreText = "Fext"
iFile = FreeFile 'Get a free file number
For Each oSld In ActivePresentation.Slides 'Loop thru each slide
'Open output file
Open sSlideOutputFolder & sPreText & Format(oSld.SlideIndex, "00") & ".txt"
For Output As iFile
s = 1
'ungroup alle items op de slide
Do Until s = 4
For Each oShp In oSld.Shapes 'Loop thru each shape on Slide
If oShp.Type = msoGroup Or oShp.Type = msoEmbeddedOLEObject Or oShp.Type =
msoLinkedOLEObject Or oShp.Type = msoTable Then
oShp.Ungroup
End If
Next oShp
s = s + 1
Loop
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
Print #iFile, oShp.TextFrame.TextRange
End If
Next oShp
'Close output file
Close #iFile
Next oSld
End Sub
And here's the macro that I would like to incorporate in the one above:
Sub ExportNotesText()
Dim oSlides As Slides
Dim oSl As Slide
Dim oSh As Shape
Dim strNotesText As String
Dim strFileName As String
Dim intFileNum As Integer
Dim lngReturn As Long
' Get a filename to store the collected text
strFileName = InputBox("Enter the full path and name of file to extract
notes text to", "Output file?")
' did user cancel?
If strFileName = "" Then
Exit Sub
End If
' is the path valid? crude but effective test: try to create the file.
intFileNum = FreeFile()
On Error Resume Next
Open strFileName For Output As intFileNum
If Err.Number <> 0 Then ' we have a problem
MsgBox "Couldn't create the file: " & strFileName & vbCrLf _
& "Please try again."
Exit Sub
End If
Close #intFileNum ' temporarily
' Get the notes text
Set oSlides = ActivePresentation.Slides
For Each oSl In oSlides
For Each oSh In oSl.NotesPage.Shapes
If oSh.PlaceholderFormat.Type = ppPlaceholderBody Then
If oSh.HasTextFrame Then
If oSh.TextFrame.HasText Then
strNotesText = strNotesText & "Slide: " & CStr(oSl.SlideNumber) & vbCrLf _
& oSh.TextFrame.TextRange.Text & vbCrLf & vbCrLf
End If
End If
End If
Next oSh
Next oSl
' now write the text to file
Open strFileName For Output As intFileNum
Print #intFileNum, strNotesText
Close #intFileNum
' show what we've done
lngReturn = Shell("NOTEPAD.EXE " & strFileName, vbNormalFocus)
End Sub
Thanks for any help,
Elke