Microsoft Office Tutorials and References
In Depth Information
Grabbing All Text
View the Appendix to learn how to store this procedure
in a Standard module.
Option Explicit¶
' * * * * *¶
Sub AllTextOut()¶
'Variable declaration¶
Dim intSlide As Integer¶
Dim intShape As Integer¶
Dim strFileName As String¶
Dim strDummy As String¶
'Set the file name that the output text will be sent to.¶
strFileName = "c:\Textout.txt"¶
strDummy = MsgBox("Do you want to include labels?", _¶
vbQuestion + vbYesNoCancel, "Label text")¶
If strDummy = vbCancel Then Exit Sub¶
'Open the output file specified earlier.¶
'If file already exists, running again will replace¶
'old contents with new contents. Use different file¶
'name to keep old data.¶
Open strFileName For Output As #1¶
With ActivePresentation¶
'Add filename label if required¶
If strDummy = vbYes Then¶
'Items printed to #1 are output to the text file¶
Print #1, "strFileName " & .Name¶
Print #1, "-----"¶
Print #1, ""¶
End If¶
'Begin a loop to run thrugh each slide in the presentation¶
For intSlide = 1 To .Slides.Count¶
'Add label if required¶
If strDummy = vbYes Then Print #1, "Slide: " & intSlide¶
'Add to the assumed prefix¶
With .Slides(intSlide)¶
'Begin the loop to cycle through each shape on the slide¶
For intShape = 1 To .Shapes.Count¶
'Add to the assumed prefix¶
With .Shapes(intShape)¶
'Add label if required¶
If strDummy = vbYes Then Print #1, "Shape: " & _¶
intShape & " " & .Name¶
'Check if there is a text frame to hold text¶
If .HasTextFrame Then¶
'If there is, then output that text to the file¶
Print #1, .TextFrame.TextRange.Text¶
End If¶
'End the shapes assumption on the prefix¶
End With¶
Pwr
Search JabSto ::




Custom Search