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

[andreas]

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

 

[Helmut Weber]

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

 

[andreas]

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

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