TextFrame and VBA

[Jeff Jones]

I have 150+ presentations, each with three hypertext links in a
TextFrame object. I need to modify each of these links. I have a
couple of VBA wonderings.

First, with MS Word I have the normal.dot file and with MS Excel I
have the personal.xls file. Both hold macros or VBA code that can be
executed against any document or spreadsheet. Thus far and as near as
I can tell, PowerPoint doesn't have a counterpart generic template
that will retain macros that may be executed against any presentation.
Is this true?

Second, I've had no problem in the past writing macros that open every
document or spreadsheet, in turn, in a folder. Once open, I can make
changes, save the changes and close and open the next asset.
PowerPoint seems to be so freeform that even if I had a generic
template, there doesn't seem to be any way that I can select a single
TextFrame on the last slide, change the three links and then save and
close the presentation before doing the next in the folder. Have any
of you done anything like this? My testing shows that each TextFrame
has a different object number. Is this true? Have any of you
selected each TextFrame object in a presentation and tested it's
contents for a particular value?

Thank you for your time.

Best Regards,
Jeff Jones
(e-mail address removed)

 

[Guest]

Hi,

First part:
http://www.rdpslides.com/pptfaq/FAQ00245.htm

Second part:
Some VBA info and code snippets that might help:
http://officeone.mvps.org/vba.html
http://www.mvps.org/skp/vba.htm

Glenna

 

[Jeff Jones]

Cool. Thank you Glenna.

I'll have fun wandering through the code along with building a
blank.pot file.

Good job.

Take care,
Jeff

 

[Steve Rindsberg]

First, with MS Word I have the normal.dot file and with MS Excel I

have the personal.xls file. Both hold macros or VBA code that can be
executed against any document or spreadsheet. Thus far and as near as
I can tell, PowerPoint doesn't have a counterpart generic template
that will retain macros that may be executed against any presentation.
Is this true?

Yes and no. You can't do something like this with a presentation but if you
write the code and turn it into an addin, once the addin's loaded it becomes,
for all practical purposes, part of PPT and stays that way until you unload it.

Create an ADD-IN with TOOLBARS that run macros
http://www.rdpslides.com/pptfaq/FAQ00031.htm

PowerPoint seems to be so freeform that even if I had a generic
template, there doesn't seem to be any way that I can select a single
TextFrame on the last slide, change the three links and then save and
close the presentation before doing the next in the folder. Have any
of you done anything like this?

Qualified yes. If the text frame in question is the normal body text
placeholder, it's possible to work with it. If it's any ol' text box, then the
problem becomes trickier.

On the other hand, you may not need to worry about the shapes at all.

Each slide has a hyperlinks collection; you can get at the address/subaddress
of each hyperlink w/o having to look for the shapes that contain them.

My testing shows that each TextFrame
has a different object number. Is this true?

Per slide, yes.

Have any of you
selected each TextFrame object in a presentation and tested it's
contents for a particular value?

Yes. Here's some sample code to get you started. Also have a look at the VBA
Programming section at http://www.pptfaq.com and the other pages it links to.

Sub Lime()

Dim oSl as Slide
Dim oSh as Shape
Dim oHl as Hyperlink

For each oSl in ActivePresentation.Slides
' display all of the text
For Each oSh in oSl.Shapes
If oSh.HasTextFrame Then
I oSh.TextFrame.HasText Then
Debug.Print oSh.TextFrame.TextRange.Text
End if
End if
Next ' Shape
' list the hyperlinks
For Each oHl in oSl.Hyperlinks
Debug.Print oHl.Address
Debug.Print oHl.SubAddress
Next ' Hyperlink
Next ' Slide

End Sub

 

[Jeff Jones]

Thank you Steve. I believe that, with your help, and that of others,
I'm sneaking up on a solution to this latest opportunity.

Take care,
Jeff

 

[Brian Reilly, MS MVP]

Jeff,
Here's another piece of code in addition to Steve's that I use all the
time as a wrapper to iterate through all shapes on all slides. Note,
I've commented out the section that you can change exactly what you
do, but the top and bottom parts are the iteration code.

Shouldn't be hard to do what you want especially if you had the list
of hyperlinks in an Excel worksheet which you could read as variable
values.

Brian Reilly, PowerPoint MVP

 

[Steve Rindsberg]

Jeff,
Here's another piece of code in addition to Steve's that I use all the
time as a wrapper to iterate through all shapes on all slides. Note,
I've commented out the section that you can change exactly what you
do, but the top and bottom parts are the iteration code.

Brian reformats his hard drive quite often. Chances are he lost his mind the
last time he did it. It's one of those pesky hidden files, ya know?

Sub DiddleAllTheShapes()

Dim oSh as Shape
Dim oSl as Slide

' Look at each slide
For Each oSl in ActivePresentation.Slides
' Look at each shape on the slide
For each oSh in oSl.Shapes
' Do whatever you need to with the shape
With oSh
Debug.Print .Name
.Left = .Left + 10
' .Whatever
End With ' The shape
Next ' Shape
Next ' Slide

End Sub

 

[Brian Reilly, MS MVP]

Thanks Steve for pointing out that I forgot to paste in my version


Sub Iterate_Through_All_Shapes_And_Read_Tags()

'PURPOSE: Refers to EACH object on EACH page and checks for a tags
..name
'Then if it is a StickyStyle Name
'Developer: Brian Reilly January 2001
Dim iShape As Integer
Dim iSlide As Integer
Dim iTags As Integer


For iSlide = 1 To ActivePresentation.Slides.Count
With ActivePresentation.Slides(iSlide)
For iShape = 1 To
ActiveWindow.Presentation.Slides(iSlide).Shapes.Count
'No need to select the object in order to use strShape

With
ActiveWindow.Presentation.Slides(iSlide).Shapes(iShape)
'''''''''''Substitute whatever code to the End of Substitute
For iTags = 1 To .Tags.Count

If .Tags.Name(iTags) = "STICKYSTYLE" Then
MsgBox "The shape " &
ActiveWindow.Presentation.Slides(iSlide) _
.Shapes(iShape).Name & " has a
Tags.Name of " & Chr(13) _
& .Tags.Name(iTags) & Chr(13) _
& "and has a Tags.Value of " &
Chr(13) & .Tags.Value(iTags)
''PROCEED WITH NEXT TAG AND NEXT OBJECT
End If

Next iTags
End With

''''''''''''End of Substitute
Next iShape
End With
Next iSlide

End Sub

 

[Jeff Jones]

LOL. I love to see people comrading.....

Here's the code I've developed thus far.

Sub ChangeHyperLinkData()

Dim oSld As Slide
Dim oAgenda As TextRange
'Stop
ActiveWindow.View.GotoSlide Index:=ActivePresentation.Slides.Count
Set oSld =
ActivePresentation.Slides(ActivePresentation.Slides.Count)

ActiveWindow.Selection.SlideRange.Shapes("Rectangle 17").Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select

With ActivePresentation.Slides(ActivePresentation.Slides.Count)
Set oAgenda =
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange
End With

With oAgenda.Sentences(1) _
.ActionSettings(ppMouseClick).Hyperlink
.Address = "http://www.gsms-am.eds.com/
<http://www.gsms-am.eds.com/> "
.TextToDisplay = "Americas: http://www.gsms-am.eds.com
<http://www.gsms-am.eds.com> " & vbNewLine
.SubAddress = ""
End With
With oAgenda.Sentences(2) _
.ActionSettings(ppMouseClick).Hyperlink
.Address = "http://www.gsms-ap.eds.com/
<http://www.gsms-ap.eds.com/> "
.TextToDisplay = "Asia Pacific: http://www.gsms-ap.eds.com
<http://www.gsms-ap.eds.com> " & vbNewLine
.SubAddress = ""
End With
With oAgenda.Sentences(3) _
.ActionSettings(ppMouseClick).Hyperlink
.Address = "http://www.gsms-ea.eds.com/
<http://www.gsms-ea.eds.com/> "
.TextToDisplay = "Europe & Africa: http://www.gsms-ea.eds.com
<http://www.gsms-ea.eds.com> "
.SubAddress = ""
End With

End Sub

It works fine as long as I open the blank.pot file that contains the
macro. I've added a button to a new toolbar that executes the macro
to the blank.pot file and it is available when I open PowerPoint but
it's not effective until the blank.pot file itself has been opened.

I'm playing with an add-in with the macro in it and can load the
add-in with no problems but the button is still not effective until
blank.pot is opened. Sigh.....

Where I want to end up is to have a macro that will open every
presentation, in turn, in a folder, change the links on the last
slide, and save the presentation.

Do you suppose that I'm sneaking up on my objective? I'm FAR too lazy
to want to make all these changes manually. Besides, it's FAR, FAR
more fun to build a macro to automate tedious tasks.

Thank you all for your help thus far. My beloved is certain that I'm
truly a computer geek and the fact that this wonderfulness if fun
supports my geekness. <giggle>

Jeff

 

[Steve Rindsberg]

LOL. I love to see people comrading.....

The way Brian and I abuse one another, you'd think we're married. ;-)

Sub ChangeHyperLinkData()

Dim oSld As Slide
Dim oAgenda As TextRange
'Stop
ActiveWindow.View.GotoSlide Index:=ActivePresentation.Slides.Count
Set oSld =
ActivePresentation.Slides(ActivePresentation.Slides.Count)

You don't need to go to the slide (ie, to display it) in order to affect it, and
in fact your code will run way faster if you don't.

Set oSld = ActivePresentation.Slides(ActivePresentation.Slides.Count)

is enough

ActiveWindow.Selection.SlideRange.Shapes("Rectangle 17").Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select

With ActivePresentation.Slides(ActivePresentation.Slides.Count)
Set oAgenda =
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange
End With

Likewise, you don't need to select anything either. Just this will do it instead
of all the above:

Set oAgenda = oSld.Shapes("Rectangle 17").TextFrame.TextRange

With oAgenda.Sentences(1) _
.ActionSettings(ppMouseClick).Hyperlink
.Address = "http://www.gsms-am.eds.com/
<http://www.gsms-am.eds.com/> "

and so on ...

It works fine as long as I open the blank.pot file that contains the
macro. I've added a button to a new toolbar that executes the macro
to the blank.pot file and it is available when I open PowerPoint but
it's not effective until the blank.pot file itself has been opened.

I'm playing with an add-in with the macro in it and can load the
add-in with no problems but the button is still not effective until
blank.pot is opened. Sigh.....

Right. The button is associated with the macro in the original pot file in PPT's
mind. Add an Auto_Open subroutine to the add-in and include code in it to create
any necessary buttons/bars/menus.

Create an ADD-IN with TOOLBARS that run macros
http://www.rdpslides.com/pptfaq/FAQ00031.htm

Where I want to end up is to have a macro that will open every
presentation, in turn, in a folder, change the links on the last
slide, and save the presentation.

Do something to every file in a folder
http://www.rdpslides.com/pptfaq/FAQ00536.htm

 

[Jeff Jones]

Thank you Steve. It seems that I have one more hurdle to overcome.
It turns out that the shape isn't always "Rectangle 17" but can be
other numbers. Therefore the line of code "Set oAgenda =
oSld.Shapes("Rectangle 17").TextFrame.TextRange" may or may not be
correct and it seems that I can't trap the error. I'm going to have
to figure out how to discern how to reference the text frame and
range. Sigh......

Jeff

 

[Steve Rindsberg]

Thank you Steve. It seems that I have one more hurdle to overcome.
It turns out that the shape isn't always "Rectangle 17" but can be
other numbers. Therefore the line of code "Set oAgenda =
oSld.Shapes("Rectangle 17").TextFrame.TextRange" may or may not be
correct and it seems that I can't trap the error. I'm going to have
to figure out how to discern how to reference the text frame and
range. Sigh......

I figured we'd cross that bridge sooner or later. What's unique about this bit of
text that you can key off of? Will it always be there and if so, will it always have
some characteristic that distinguishes it from the other text on the slide?

Or can you create it yourself as needed?

 

[Jeff Jones]

I expected to find this bridge as well.

There are three lines of text and the initial characters in each line
can uniquely identify each. One starts with Americas, another with
Asia and the third with Europe. Each line will always be there and
should always be on the last slide.

I wandered through various code examples looking for a character
string but couldn't figure out how to marry that code to the code to
set a hypertext link.

There's no reason why I can't create the TextFrame myself although,
I'd need to drop the existing object before creating my own.


Jeff

 

[Steve Rindsberg]

I expected to find this bridge as well.

There are three lines of text and the initial characters in each line
can uniquely identify each. One starts with Americas, another with
Asia and the third with Europe. Each line will always be there and
should always be on the last slide.

I wandered through various code examples looking for a character
string but couldn't figure out how to marry that code to the code to
set a hypertext link.

Hm. Something like this (off top of head, may require a bit of tweakage):

Function WheresWaldosTextBox(oPresentation As Presentation) As Shape
' Returns the text box you need to work with

Dim oSh As Shape

' Look at the last slide in the presentation's shapes
For Each oSh In oPresentation.Slides(oPresentation.Slides.Count).Shapes
If Mid$(oSh.TextFrame.TextRange.Paragraphs(1), 1, Len("America")) = "America" Then
If Mid$(oSh.TextFrame.TextRange.Paragraphs(2), 1, Len("Japan")) = "Japan" Then
If Mid$(oSh.TextFrame.TextRange.Paragraphs(3), 1, Len("Korea")) = "Korea" Then
Set WheresWaldosTextBox = oSh
Exit Function
End If
End If
End If
Next ' Shape

End Function

Sub testWaldo()
MsgBox WheresWaldosTextBox(ActivePresentation).TextFrame.TextRange.Text
End Sub

 

[Jeff Jones]

Hi Steve,

Thank you for the snippet of code. I did get to tweak it a little
and, for the most part, got it to work properly. Here's the code.


Sub TestShapes()

Dim numShapes, numAutoShapes, i As Long
Dim oSld As Slide
Dim oAgenda As TextRange
Dim varTextFrame As Variant

On Error GoTo HandleError
'Stop
Set myDocument =
ActivePresentation.Slides(ActivePresentation.Slides.Count)
With myDocument.Shapes
numShapes = .Count
If numShapes > 1 Then
numTextShapes = 0
For i = 1 To numShapes - 1
If .Item(i).HasTextFrame Then
' If .Item(i).HasText Then
numTextShapes = numTextShapes + 1

varTextFrame = .Item(i).Name

ActiveWindow.View.GotoSlide
Index:=ActivePresentation.Slides.Count
Set oSld =
ActivePresentation.Slides(ActivePresentation.Slides.Count)


ActiveWindow.Selection.SlideRange.Shapes(varTextFrame).Select

Set oAgenda =
oSld.Shapes(varTextFrame).TextFrame.TextRange

If Mid$(oAgenda.Sentences(1), 1, Len("America")) =
"America" Then
' Stop
With oAgenda.Sentences(1) _
.ActionSettings(ppMouseClick).Hyperlink
.Address = "http://www.gsms-am.eds.xxx/
<http://www.gsms-am.eds.xxx/> "
.TextToDisplay = "Americas:
http://www.gsms-am.eds.xxx <http://www.gsms-am.eds.xxx> " & vbNewLine
.SubAddress = ""
End With

With oAgenda.Sentences(2) _
.ActionSettings(ppMouseClick).Hyperlink
.Address = "http://www.gsms-ap.eds.yyy/
<http://www.gsms-ap.eds.yyy/> "
.TextToDisplay = "Asia Pacific:
http://www.gsms-ap.eds.yyy <http://www.gsms-ap.eds.yyy> " & vbNewLine
.SubAddress = ""
End With
With oAgenda.Sentences(3) _
.ActionSettings(ppMouseClick).Hyperlink
.Address = "http://www.gsms-ea.eds.zzz/
<http://www.gsms-ea.eds.zzz/> "
.TextToDisplay = "Europe & Africa:
http://www.gsms-ea.eds.zzz <http://www.gsms-ea.eds.zzz> "
.SubAddress = ""
End With
End If
' End If
End If
NextFor:
Next
End If
End With

Exit Sub

HandleError:
'Stop
If Err.Number = 9 Then

GoTo NextFor
' Exit Sub
End If
Resume
If Err.Number <> 0 Then
Msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
End If


End Sub

The only rub is due to the fact that is seems that some people have a
habit of leaving empty objects or shapes on slides rather than using
or deleting them when adding a new slide. Th ecode worked correctly
on 3 out of 4 presentations until I deleted the empty objects on the
fourth. It then worked fine on all the test presentations. It seems
that I'll be faced with some manual cleanup whether I like it or not.
Oh well..... This is still easier that manually changing the links on
every presentation.

If you have anu suggesgions, I'd like to hear them. In the meantime,
thank you VERY much for your help!


Jeff

 

[Steve Rindsberg]

On Error GoTo HandleError

'Stop
Set myDocument =
ActivePresentation.Slides(ActivePresentation.Slides.Count)

Now suppose we sneak in right about here and do this:

' Delete any shapes that might hold text but don't and
' that are unfilled/unoutlined
Dim X as Long
Dim oSh as Shape
For x = myDocument.Shapes.Count to 1 Step -1
Set oSh = myDocument.Shapes(x)
' Can the shape hold text?
if oSh.HasTextFrame then
' Does it have text?
if not osh.TextFrame.HasText Then
' Is it filled
if not osh.fill.visible then
' does it have an outline?
if not osh.line.visible then
' IT DIES
osh.delete
end if
end if
end if
end if
Next ' x

 

[Jeff Jones]

Steve,
We certainly pay a price for PowerPoint flexibility. I lost
power today and am way behind. I'll add this code into the code I
have to get rid or empty text objects.

I did run some more tests and have found that the code to spin through
all presentations in a folder works just fine with my code. BTW, I
have the go to and selection of the object in place to be able to
debug the code. Once it's working properly, I'll not need those
lines.

Anyway, I end up with some errors on a few presentations. The
error show up when I set the TextRange to the data in the TextFrame.
My testing shows a valid name for the TextFrame. I have only 6 shapes
on slide. When I record a macro and select each shape in turn, I get
expected results. However, when I select the shape via the code I get
the error. I tried replacing the 2 shapes with some from a slide that
I knew was OK to no avail. I then tried replacing the entire slide.
The last slide is the same on every presentation. The code didn't
have the error with that slide. It appears that if I end up with this
error, and I can't trap it since the error number is -2147024809, if I
delete the slide and copy in a slide that is correct I'll have what I
want. Pretty crazy.

I can't categorically just add a new slide to the end of every
presentation because some are children presentations to a master and
don't need that final slide. Given the fact that I get the error
before I can text the contents of the TextFrame to see if there is
text and if the text starts with the Americas character string, I
still need to run the code we've worked out. Ain't technology grand!
I'm 99% closer to declaring victory that I would be without your help.
Thank you. You're doing GREAT!

Jeff

 

[Steve Rindsberg]

error show up when I set the TextRange to the data in the TextFrame.

My testing shows a valid name for the TextFrame. I have only 6 shapes
on slide. When I record a macro and select each shape in turn, I get
expected results. However, when I select the shape via the code I get
the error. I tried replacing the 2 shapes with some from a slide that
I knew was OK to no avail. I then tried replacing the entire slide.
The last slide is the same on every presentation. The code didn't
have the error with that slide. It appears that if I end up with this
error, and I can't trap it since the error number is -2147024809, if I
delete the slide and copy in a slide that is correct I'll have what I
want. Pretty crazy.

Sometimes slides or shapes on slides get corrupted; you might find that,
impossible though it's supposed to be, there are two shapes with the same name
on the slide. PowerPoint sometimes gets happyFingers just like us organic
lifeforms! Wheeee. Try roundtripping the presentation to HTML as a test; if
that fixes it, you probably had a corrupt shape on the slide.

 

[Jeff Jones]

I put together some code that deletes the last slide and copies the
only slide from my blank.pot file into the presentation I'm working
on. That seems to solve the problem, at least until the next problem.
<giggle> I'll try the HTML toggle to test the integrity of the slide.
I have observed that we get unexpected features for some of microsoft
apps and wouldn't be surprised that PowerPoint has its own. 'Course,
I still use microsoft apps so I clearly am able to get around the
features.

I'll let you know what happens with the HTML toggle tomorrow morning.
I have a healthy group of stuff to catch up on. Sigh......

The batteries are charging as my phabulous phlying phlanges dance over
the keys......


Take care,
Jeff

 

[Steve Rindsberg]

I put together some code that deletes the last slide and copies the
only slide from my blank.pot file into the presentation I'm working
on. That seems to solve the problem, at least until the next problem.
<giggle> I'll try the HTML toggle to test the integrity of the slide.
I have observed that we get unexpected features for some of microsoft
apps

Aw shoot. Push any app from anybody hard and you'll get unexpected features. ;-)

Not PowerPoint, naw, nope nuh-uh, never. ROFL!