Changing all text properties of Shapes in a workbook [SOLVED

Hi Rennie,
I've never used Word Art, but please try this code.

Sub Change_Text()
Dim ws As Worksheet, shp As Shape
For Each ws In Worksheets
For Each shp In ws.Shapes
If shp.Type = msoTextEffect Then
shp.TextEffect.Text = Sheets(1).[A1].Value
End If
Next
Next
End Sub

Hi Rennie

Try

Sub Change_Text()
Dim strText As String
Dim wSheet As Worksheet
Dim sShape As Shape
strText = Worksheets(1).Range("A1")
  For Each wSheet In Worksheets
     For Each sShape In wSheet.Shapes
       If sShape.Type = msoTextEffect Then
          sShape.TextEffect.Text = strText
       End If
      Next sShape
     Next wSheet
End Sub

Sorry Colo, didn't see your post.

I have a (tested) solution for you, where the font is based on a reference cell (i.e. A1)
Sub Change_Text2()
ActiveSheet.Shapes.SelectAll
With Selection.Characters.Font
.Name = Range("a1").Font.Name
.FontStyle = Range("a1").Font.FontStyle
.Size = Range("a1").Font.Size
.ColorIndex = Range("a1").Font.ColorIndex
End With
Range("a1").Select
End Sub

If you require, you can add more font properties into the 'with' - 'end with' section, such as
.Strikethrough =
.Superscript =
.Subscript =
.OutlineFont =
.Shadow =
.Underline =

HTH, Manfred

Hi Dave,
I have tried both yours and Colo's code and I can not get them to work, i.e. non of the shapes seem to get selcted.

What am I missing?
Thanks for your input.

I am running O2k on Win2k.
Regards, Manfred

Hi manfredm

Both mine and Colo's work only on the WordArt Shapes. We both made that assumption based on:

Quote

I have water marks created using word art on a number of sheets in a workbook.

Wouldn't be the first time I was wrong wrong though

Hi Dave, No problem. No need to say sorry. Similar code! LOL

Hi Manfred,
I think, I have thought the shapes must be word art from Rennie's post. (Dave might have)

Thanx Dave,
you are right, of course.
I missed that part and had based my solution on ordinary AutoShapes.

Thanx, Manfred