formatting table cells with WordArt

[jmp123]

I'm trying to create a sheet of labels to use on book spines. Each
label will contain one letter formatted and colored with WordArt and
centered on the label (first letter of author's last name). I've
managed to create a sheet of labels containing the one letter centered
in each label, but I can't seem to figure out how to automate changing
the letters to WordArt, although I can do it manually.

I was attempting to loop through each cell (standard Avery label
layout), select the text and change to WordArt, and then change the
color of the text. I did manage to do it once, but the WordArt all
ended up in the middle of the document.

Can anyone tell me how to loop through, select the text in each cell
and change it to WordArt in the same spot? Recording the macro gives me
the middle of the document as anchor points - I can't figure out what
the anchor points would be for each label.

Any suggestions would be greatly appreciated!

Jane

 

[Jay Freedman]

Hi Jane,

Have a look at the VBA help topic on the AddTextEffect method. The key to
your problem is the last parameter defined in the method's syntax, Anchor,
which is optional. The Anchor is the range to which the resulting WordArt is
attached, and the Left and Top parameters give the distances from the
anchor. When the anchor isn't specified, VBA assumes that it's the top left
corner of the page -- not what you want. You need to set the anchor for each
piece of WordArt as the range of the table cell in which the WordArt should
appear; then both Left and Top should be zero. Finally, you need to convert
the resulting Shape object into an InLineShape object so it doesn't float
over the table but actually lives in the table cell.

There are some other issues around handling errors and changing colors. Let
me know if you need any more explanation than the comments in the following
code:

Sub MakeWordArt()
Dim oRg As Range
Dim oTbl As Table
Dim oCel As Cell
Dim oShp As Shape
Dim strText As String
Dim effect As MsoPresetTextEffect
Dim strFontName As String
Dim sngFontSize As Single
Dim bFontBold As MsoTriState, bFontItalic As MsoTriState
Dim sngLeft As Single, sngTop As Single

' set up values of parameters
effect = msoTextEffect8 ' entry in WordArt Gallery
strFontName = "Arial"
sngFontSize = 36# ' size in points
bFontBold = msoCTrue
bFontItalic = msoFalse
sngLeft = 0 ' distances from anchor
sngTop = 0

If ActiveDocument.Tables.Count = 0 Then
MsgBox "There are no tables.", , "Error"
Exit Sub
End If

Set oTbl = ActiveDocument.Tables(1)

For Each oCel In oTbl.Range.Cells
Set oRg = oCel.Range
oRg.MoveEnd wdCharacter, -1
strText = oRg.Text
If Len(strText) > 0 Then
oRg.Text = "" ' remove plain text
Set oShp = ActiveDocument.Shapes.AddTextEffect( _
PresetTextEffect:=effect, _
Text:=strText, _
fontName:=strFontName, _
fontSize:=sngFontSize, _
fontBold:=bFontBold, _
fontItalic:=bFontItalic, _
left:=sngLeft, top:=sngTop, _
Anchor:=oRg)
oShp.Fill.ForeColor.RGB = RGB(255, 0, 0) ' red
oShp.ConvertToInlineShape
End If
Next
End Sub

--
Regards,
Jay Freedman
Microsoft Word MVP
Email cannot be acknowledged; please post all follow-ups to the newsgroup so
all may benefit.