Re: TextFrame and VBA
From: Jeff Jones (jpjones23_at_earthlink.net)
Date: 01/17/05
- Next message: Brian Reilly, MS MVP: "Re: VBA with Powerpoint"
- Previous message: Brian Reilly, MS MVP: "Re: embedded object"
- In reply to: Steve Rindsberg: "Re: TextFrame and VBA"
- Next in thread: Steve Rindsberg: "Re: TextFrame and VBA"
- Reply: Steve Rindsberg: "Re: TextFrame and VBA"
- Messages sorted by: [ date ] [ thread ]
Date: Mon, 17 Jan 2005 23:08:21 GMT
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
On Mon, 17 Jan 2005 01:18:08 EST, Steve Rindsberg
<abuse@localhost.com> wrote:
>In article <879mu01d832p03c1bcenr36p58foljaqo9@4ax.com>, Jeff Jones wrote:
>> 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
>
>
>
>
>
>>
>> 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
>>
>> On Sun, 16 Jan 2005 19:24:56 EST, Steve Rindsberg
>> <abuse@localhost.com> wrote:
>>
- Next message: Brian Reilly, MS MVP: "Re: VBA with Powerpoint"
- Previous message: Brian Reilly, MS MVP: "Re: embedded object"
- In reply to: Steve Rindsberg: "Re: TextFrame and VBA"
- Next in thread: Steve Rindsberg: "Re: TextFrame and VBA"
- Reply: Steve Rindsberg: "Re: TextFrame and VBA"
- Messages sorted by: [ date ] [ thread ]
Relevant Pages
|
