change the font in all text boxes Word 2003

[fosterp]

Hi
How do you change the font in all text boxes to another font.
e.g. if I wanted to change all fonts in a text box to Arial. How would I do it?
Please could someone help.
Code below:
Sub chgfont()
'Set r = ActiveDocument.Range
'With r
Set txtTitle = ActiveDocument.Shapes '.AddTextbox(msoTextOrientationHorizontal, 89, 69, 400, 25)
With txtTitle
With .TextFrame ' error: Object doesn't support this property or method (Error 438)

.Font.Name = "Arial"
.Font.Bold = True
.Font.Size = 18
End With
End With

End Sub

[Tinbendr]

Sub chgfont()
Dim TxtTitle As Shape
Dim Rng As Range
Set Rng = ActiveDocument.Range
Set TxtTitle = Rng.Shapes.AddTextbox( _
msoTextOrientationHorizontal, _
89, 69, 400, 25)
With TxtTitle
With .TextFrame.TextRange
.Font.Name = "Arial"
.Font.Bold = True
.Font.Size = 18
.Text = "This is a test"
End With
End With
End Sub

[lucas]

Hi Tinbendr,
I had to change one little part of your code to get this to work for me......it's really late though so I could be off base...
Option Explicit
Sub chgfont()
Dim TxtTitle As Shape
Dim Rng As Range
Set Rng = ActiveDocument.Range
Set TxtTitle = ActiveDocument.Shapes.AddTextbox( _
msoTextOrientationHorizontal, _
89, 69, 400, 25)
With TxtTitle
With .TextFrame.TextRange
.Font.Name = "Arial"
.Font.Bold = True
.Font.Size = 18
.Text = "This is a test"
End With
End With
End Sub

[fosterp]

Thx for your replies. the thing is, I already have text boxes with the text inside them.
It's another person;s document and I need to change the fonts on all the existing textboxes to another font.

In my case, it would be "Akzidenz-Grotesk Std Regular"

[Tinbendr]

Lucas, I must have had Range on the brain yesterday. It should be Document, not Range. That's what I get for not testing the final edit. :doh:

FosterP, try this.

Sub TboxFontChange()
Dim eShape As Shape
Dim aDoc As Document

Set aDoc = ActiveDocument
For Each eShape In aDoc.Shapes
If eShape.Type = msoTextBox Then
With eShape
With .TextFrame.TextRange
.Font.Name = "Arial"
.Font.Bold = True
.Font.Size = 18
End With
End With
End If
Next
End Sub

[RBarrett]

Why not apply a style to the text in the text boxes? (Slight variaion on the same macro.) Then when you (or someone else) wants to change the font, it will be just a matter of modifying the style.

[fosterp]

Thx Tinbendr, that worked.
I tested it on a document and it worked well.
However, what happens if you

goto Properites and right click and the box claims to bea text box but when you run the code, the text font doesn't change!! it remains as Arial!
How do you change the text in those boxes?

as ".TextFrame.TextRange" only applies to text boxes.

[Tinbendr]

Try changing this line in the code.
If eShape.Type = msoTextBox Or msoShapeRectangle Then

[fosterp]

Thx agaiin but the problem is:

With .TextFrame.TextRange

does not support attached text for

msoShapeRectangle


Is there any way I can send you an attachment showing you what I need to do?

[lucas]

forsep, to attach your document to your post go to post reply at the lower left of the last post and then scroll down and look for a button that says "manage attachments"

remove any proprietary info before posting it.

[fosterp]

Thx Lucas.

I have enclosed a sample graphic and basically I want all text boxes font changed to

Akzidenz-Grotesk Std Regular

for all the boxes in the doc.

Hope this makes sense.

[lucas]

fosterp
Grouping is a problem for this action for one thing. After I ungrouped the shapes I also discovered that the two boxes you have text in are not textboxes but rectangles. Don't group them is my best guess and from the drawing toolbar hover over until it reads textbox not rectangle.

[Tinbendr]

Sub TboxFontChangeWithGroup()
Dim eShape As Shape
Dim aDoc As Document

Set aDoc = ActiveDocument

For Each eShape In aDoc.Shapes
If eShape.Type = msoGroup Then
For I = 1 To eShape.GroupItems.Count
With eShape.GroupItems(I).TextFrame
If .HasText Then
With .TextRange.Font
.Name = "Courier New"
.Bold = True
.Size = 18
End With
End If
End With
Next
Else
If eShape.Type = msoTextBox Or msoShapeRectangle Then
With eShape.TextFrame.TextRange.Font
.Name = "Courier New"
.Bold = True
.Size = 18
End With
End If
End If
Next
End Sub


I found answer here (http://groups.google.com/group/microsoft.public.word.vba.general/browse_thread/thread/c52c5ef841310036/5519d654d6aef53d?hl=en&lnk=gst&q=shapes+group+textrange#5519d654d6aef53d).

[lucas]

That works......good one tinbendr. Thanks for contributing.

[fosterp]

Thx for all your help but still get an error when running the code in the line:

With eShape.TextFrame.TextRange.Font

error: This object does not support attached text

[Tinbendr]

Perhaps we need to add the Hastext conditional to the the Else, also.

If eShape.Type = msoTextBox Or msoShapeRectangle Then
With eShape.TextFrame.TextRange
If .HasText then
.Font.Name = "Courier New"
.Font.Bold = True
.Font.Size = 18
end if
End With
End If

[fosterp]

Thx so mcuh. I just made a few tweaks and it works great now.