CG159
07-27-2012, 04:15 PM
I am going crazy over this set of code and I was wondering if anyone could assist me in completing it.... My coding skills are limited and I had someone else help me get this far but we are now stuck.
Try to stay with on this:
Using a Macro in powerpoint, I am trying to extract text from powerpoint slides and output the text in the .ppt file to a .txt file. The text I am trying to extract is based upon a particular slide title.
For example, any slide that is begins with the title," I am number:". I want to take the text from ALL slides from an entire powerpoint that begin with this title and place them into a text file. So slides with the titles "I am number 10", "I am number 12", and am "number 34" would be extracted based upon this code.
I have about 20 powerpoint slides and I need to output a txt file for each powerpoint.
So, the code below should be able to take all 20 files and output a .txt file with the text I need from those slide titles. Some text in the powerpoint may be within a table, it varies.
The problems when I run this code are:
-The output only contains 1 or 2 lines of text and not the whole slide, especially if a table is involved. In which case it only returns the first two columns.
-I cannot get the code to extract every single slide. It stops after 1 slide.
-The code outputs display text instead of hyperlink text. (I think it may be best if I create another macro to change all display text to hyperlink text, but I have been unable to come up with one that works so far)
If anyone could provide any assistance I would be extremely grateful.
'~~> Change Slide Title here
Const ppSTitle As String = "Walkthrough"
'~~> Change PPT Source Directory Here
Const sDir As String = "C:\Documents and Settings\r126162\Desktop\test\"
Sub Sample()
Dim ppPrsn As Presentation
Dim ppSlide As Slide
Dim filesize As Integer
Dim shp As Shape
Dim vFile
Dim No As Long
vFile = Dir(sDir & "*.ppt*")
No = 1
Do While vFile <> ""
Set ppPrsn = Presentations.Open(FileName:=sDir & vFile)
For Each ppSlide In ppPrsn.Slides
If InStr(1, ppSlide.Shapes.Title.TextFrame.TextRange.Text, ppSTitle, vbTextCompare) Then
'~~> Get a free file handle
filesize = FreeFile()
'~~> Open your file
Open vFile & ".txt" For Output As #filesize
For Each shp In ppSlide.Shapes
If shp.HasTextFrame Then
If shp.TextFrame.HasText Then
'~~> Export Text
Print #filesize, shp.TextFrame.TextRange.Text & " " & shp.TextFrame.TextRange.Characters.ActionSettings(ppMouseClick).Hyperlink.A ddress
End If
End If
Next
Close #filesize
No = No + 1
Exit For
End If
Next
ppPrsn.Close
vFile = Dir
Loop
Set ppPrsn = Nothing
End Sub
Try to stay with on this:
Using a Macro in powerpoint, I am trying to extract text from powerpoint slides and output the text in the .ppt file to a .txt file. The text I am trying to extract is based upon a particular slide title.
For example, any slide that is begins with the title," I am number:". I want to take the text from ALL slides from an entire powerpoint that begin with this title and place them into a text file. So slides with the titles "I am number 10", "I am number 12", and am "number 34" would be extracted based upon this code.
I have about 20 powerpoint slides and I need to output a txt file for each powerpoint.
So, the code below should be able to take all 20 files and output a .txt file with the text I need from those slide titles. Some text in the powerpoint may be within a table, it varies.
The problems when I run this code are:
-The output only contains 1 or 2 lines of text and not the whole slide, especially if a table is involved. In which case it only returns the first two columns.
-I cannot get the code to extract every single slide. It stops after 1 slide.
-The code outputs display text instead of hyperlink text. (I think it may be best if I create another macro to change all display text to hyperlink text, but I have been unable to come up with one that works so far)
If anyone could provide any assistance I would be extremely grateful.
'~~> Change Slide Title here
Const ppSTitle As String = "Walkthrough"
'~~> Change PPT Source Directory Here
Const sDir As String = "C:\Documents and Settings\r126162\Desktop\test\"
Sub Sample()
Dim ppPrsn As Presentation
Dim ppSlide As Slide
Dim filesize As Integer
Dim shp As Shape
Dim vFile
Dim No As Long
vFile = Dir(sDir & "*.ppt*")
No = 1
Do While vFile <> ""
Set ppPrsn = Presentations.Open(FileName:=sDir & vFile)
For Each ppSlide In ppPrsn.Slides
If InStr(1, ppSlide.Shapes.Title.TextFrame.TextRange.Text, ppSTitle, vbTextCompare) Then
'~~> Get a free file handle
filesize = FreeFile()
'~~> Open your file
Open vFile & ".txt" For Output As #filesize
For Each shp In ppSlide.Shapes
If shp.HasTextFrame Then
If shp.TextFrame.HasText Then
'~~> Export Text
Print #filesize, shp.TextFrame.TextRange.Text & " " & shp.TextFrame.TextRange.Characters.ActionSettings(ppMouseClick).Hyperlink.A ddress
End If
End If
Next
Close #filesize
No = No + 1
Exit For
End If
Next
ppPrsn.Close
vFile = Dir
Loop
Set ppPrsn = Nothing
End Sub