W
W.J.Surrarrer
I have array formulas that automatically regenerate a year long
calandar (3 months wide x 4 months deep) when the calandar year is
changed. I want to automatically regenerate WordArt "A" (in red) and
"B" (in blue), alternating every other friday, when the calandar year
is changed. Currently I use the macro below (must change A/B and color
10/4) to insert and position the WordArt. Some years the first friday
is in week one other years it is in week two, some years need to start
with "A" and other years need to start with "B". January Fridays fall
in Range(G9:G13), February Fridays fall in Range(N9:N13), March
Fridays fall in Range(U9:U13), April Fridays fall in Range(G17:G21),
May Fridays fall in Range(N17:N21), March Fridays fall in
Range(U17:U21), etc.
Sub AddWordArt1()
Dim celTop As Long
celTop = ActiveCell.Top
Dim SH As Excel.Shape
Set SH = ActiveSheet.Shapes.AddTextEffect(TextEffect6, _
"A", "Arial Black", 20#, False, False, 21.75, celTop)
With SH
.Height = 25
.Width = 22
.Fill.Visible = True
.Fill.Solid
.Fill.ForeColor.SchemeColor = 10 '4 blue 10 Red
.Fill.Transparency = 0#
.Line.Weight = 0.75
.Line.DashStyle = 1
.Line.Style = 1
.Line.Transparency = 0#
.Line.Visible = True
.Line.ForeColor.SchemeColor = 10 '4 blue 10 Red
.Line.BackColor.RGB = RGB(255, 255, 255)
.LockAspectRatio = False
.ZOrder BringToFront
.Left = Selection.Left
.IncrementLeft 19
.IncrementTop 11
End With
End Sub
calandar (3 months wide x 4 months deep) when the calandar year is
changed. I want to automatically regenerate WordArt "A" (in red) and
"B" (in blue), alternating every other friday, when the calandar year
is changed. Currently I use the macro below (must change A/B and color
10/4) to insert and position the WordArt. Some years the first friday
is in week one other years it is in week two, some years need to start
with "A" and other years need to start with "B". January Fridays fall
in Range(G9:G13), February Fridays fall in Range(N9:N13), March
Fridays fall in Range(U9:U13), April Fridays fall in Range(G17:G21),
May Fridays fall in Range(N17:N21), March Fridays fall in
Range(U17:U21), etc.
Sub AddWordArt1()
Dim celTop As Long
celTop = ActiveCell.Top
Dim SH As Excel.Shape
Set SH = ActiveSheet.Shapes.AddTextEffect(TextEffect6, _
"A", "Arial Black", 20#, False, False, 21.75, celTop)
With SH
.Height = 25
.Width = 22
.Fill.Visible = True
.Fill.Solid
.Fill.ForeColor.SchemeColor = 10 '4 blue 10 Red
.Fill.Transparency = 0#
.Line.Weight = 0.75
.Line.DashStyle = 1
.Line.Style = 1
.Line.Transparency = 0#
.Line.Visible = True
.Line.ForeColor.SchemeColor = 10 '4 blue 10 Red
.Line.BackColor.RGB = RGB(255, 255, 255)
.LockAspectRatio = False
.ZOrder BringToFront
.Left = Selection.Left
.IncrementLeft 19
.IncrementTop 11
End With
End Sub