fonts names in loops

[Guest]

I want to use a loop with wordart and I want to change the font name on each
loop. If the font names have number equivalents I can do it easily.
However, I can't find any place that shows that font names have numbe
equivalents. Anyone have a suggestion.

 

[Guest]

Disregard this posting. Here is how I solved the problem.

[Sub WATest()
fnt1 = "Arial"
fnt2 = "Kristen ITC"
fnt3 = "Algerian"
Counter = 1
Do
Set myDocument = Worksheets(2)
Set newWordArt = myDocument.Shapes.AddTextEffect
_(PresetTextEffect:=msoTextEffect + Counter, Text:="Watch This",
FontName:=fnt_ & Counter, FontSize:=(Counter * 2) + 40, FontBold:=False,
FontItalic:=False, _ Left:=300, Top:=150)
WaitTime
newWordArt.TextEffect.RotatedChars = msoTrue
WaitTime
newWordArt.TextEffect.ToggleVerticalText
WaitTime
newWordArt.TextEffect.RotatedChars = msoTrue
WaitTime
newWordArt.TextEffect.ToggleVerticalText
WaitTime
newWordArt.Flip msoFlipVertical
WaitTime
newWordArt.Flip msoFlipHorizontal
WaitTime
Worksheets(2).Shapes(1).Delete
WaitTime
Counter = Counter + 1
Loop Until Counter = 4
End Sub]

By using the [ fnt " &" or "+" counter] it will change font name for the
three named at the beginning of the sub.

 

[Dave Peterson]

Even though you have a solution, you may want to look at the way John Walkenbach
gets font names:

http://www.j-walk.com/ss/excel/tips/tip79.htm

 

[Guest]

Thanks Dave, I did not have the solution. I jumped the gun on that one. It
does not work like I thought. I guess I was too tired when I tested it and
thought I saw something that was not there. I'll check out the URL you
listed. Thanks again.

 

[Guest]

OK, Now I have it so it works. Here is the code:

Sub WATest()
Dim fnt(3) As Variant
fnt(1) = "Comic Sans MS"
fnt(2) = "Impact"
fnt(3) = "Algerian"
Counter = 1
Do
Set myDocument = Worksheets(2)
Set newWordArt =
myDocument.Shapes.AddTextEffect(PresetTextEffect:=msoTextEffect + (Counter +
2), Text:="Watch This", FontName:=fnt(Counter), FontSize:=(Counter * 2) + 40,
FontBold:=False, FontItalic:=False, Left:=300, Top:=150)
WaitTime
newWordArt.TextEffect.RotatedChars = msoTrue
WaitTime
newWordArt.TextEffect.ToggleVerticalText
WaitTime
newWordArt.TextEffect.RotatedChars = msoTrue
WaitTime
newWordArt.TextEffect.ToggleVerticalText
WaitTime
newWordArt.Flip msoFlipVertical
WaitTime
newWordArt.Flip msoFlipHorizontal
WaitTime
Worksheets(2).Shapes(1).Delete
WaitTime
Counter = Counter + 1
Loop Until Counter = 4
End Sub

Some of the msoTextEffect will not respond to the flip and rotate commands
so they act a little differently while the code is running. But it changes
the fonts on each loop and that is what I was looking for. Hope this helps
someone.