Apply another font to all text boxes within a canvas or to grouped text boxes

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

andreas - 28 Jun 2008 07:14 GMT

Dear Experts:
Below macro changes all text within text boxes to "arial ,bold, Size
8". So far, so good. This macro is working

a. But I also got text boxes within canvasses. How do I have to
change the code so that text boxes within canvases also get their font
changed to "Arial Bold 8"?
b. I also got grouped text boxes in my document. How do I have to
change the code so that grouped text boxes also get their font changed
to "Arial Bold 8"?

Help is much appreciated. Thank you very much in advance. Regards,
Andreas

Sub ApplyFontToTextBoxes()
Dim shp As Word.Shape

For Each shp In ActiveDocument.Shapes
With shp.TextFrame
If .HasText Then
.TextRange.Font.Name = "Arial"
.TextRange.Font.Size = 8
.TextRange.Bold = True
End If
End With
Next shp
End Sub

Reply to this Message

Helmut Weber - 28 Jun 2008 21:06 GMT

Hi Andreas,

perhaps like that, and
watch out for line continuation:

Sub ApplyFontToTextBoxes()
Dim i As Long ' group items count
Dim l As Long ' shapes.count
Dim x As Long ' a shape's index
Dim y As Long ' a shape's canvas items count
Dim z As Long ' a shape's canvas item index
Dim shp As Word.Shape
l = ActiveDocument.Shapes.Count
For x = 1 To l
i = ActiveDocument.Shapes(x).GroupItems.Count
For z = 1 To i
If ActiveDocument.Shapes(x).GroupItems(z). _
TextFrame.HasText Then
ActiveDocument.Shapes(x).GroupItems(z). _
TextFrame.TextRange.Font.name = "Arial"
End If
Next
If ActiveDocument.Shapes(x).TextFrame.HasText Then
ActiveDocument.Shapes(x).TextFrame. _
TextRange.Font.name = "Arial"
End If
' ActiveDocument.Shapes(x).Select
On Error Resume Next '!
y = ActiveDocument.Shapes(x).CanvasItems.Count
For z = 1 To y
ActiveDocument.Shapes(x).CanvasItems(z). _
TextFrame.TextRange.Font.name = "Arial"
Next
Next

End Sub
--

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Vista Small Business, Office XP

Reply to this Message

andreas - 29 Jun 2008 12:38 GMT

> Hi Andreas,
>
[quoted text clipped - 39 lines]
>
> Vista Small Business, Office XP

Dear Helmut,

as always your macros are running just fine. Thank you very much for
your terrific help.
It is always astonishing how quickly you come up with your solutions.

Best Regards and thank you very much again,

Andreas

Reply to this Message