J
Jim
I have some perfectly good code that draws shapes that works in Excel
2003 and Excel 2004 (Mac).
However, in Excel 2007 the results produced are very different. It
would seem that the shape definition parameters have changed. And of
course you can't learn by recording because parts of the recorder have
been disabled. Does anyone have a work around?
As an example, here's some code for drawing a circular arc that
smoothly joins one end of a trapezoid. Works fine in Excel 2003, but
not in 2007.
I'll be glad to provide the spreadsheet with the completed drawing.
Sub macro1()
rn = 0.1 * 3
theta = 75
rf = 0.096592583 * 3
rb = 0.364541775060029 * 3
lgth = 1 * 3
Call DrArc(100, 300, rn, theta, newlft, nm1)
lft = newlft
Call DrTrap(lft, 300, rf, lgth, rb, newlft, nm2)
End Sub
Sub DrArc(lft, mid1, r, thet, newlft, nm1)
'
r1 = 72 * r
rad = Atn(1) / 45
a1 = thet * rad
h1 = r1 * Sin(a1)
w1 = r1 * (1 - Cos(a1))
ActiveSheet.Shapes.AddShape(msoShapeArc, lft, mid1 - h1, r1, 2 *
h1).Select
Selection.ShapeRange.Adjustments.Item(1) = thet
Selection.ShapeRange.Adjustments.Item(2) = -thet
Selection.ShapeRange.Flip msoFlipHorizontal
Selection.ShapeRange.Height = 2 * h1
Selection.ShapeRange.Width = r1
nm1 = Selection.Name
Selection.Top = mid1 - h1
Selection.Left = lft
newlft = lft + w1
Call Grad_Fill(9)
End Sub
Sub Grad_Fill(kolor)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = kolor
Selection.ShapeRange.Fill.OneColorGradient msoGradientHorizontal,
4, 0.23
End Sub
Sub DrTrap(lft, mid1, rf, lng, rb, newlft, nm1)
l1 = 72 * lng
r1 = 72 * Application.WorksheetFunction.Min(rf, rb)
r2 = 72 * Application.WorksheetFunction.Max(rf, rb)
ActiveSheet.Shapes.AddShape(msoShapeTrapezoid, lft, mid1 - r2, 2 *
r2, l1). _
Select
Selection.ShapeRange.IncrementRotation 90#
If rf > rb Then Selection.ShapeRange.Flip msoFlipHorizontal
Selection.ShapeRange.Adjustments.Item(1) = (1 - r1 / r2) / 2
nm1 = Selection.Name
Call Grad_Fill(9)
Selection.Top = mid1 - r2
Selection.Left = lft
newlft = lft + l1
End Sub
2003 and Excel 2004 (Mac).
However, in Excel 2007 the results produced are very different. It
would seem that the shape definition parameters have changed. And of
course you can't learn by recording because parts of the recorder have
been disabled. Does anyone have a work around?
As an example, here's some code for drawing a circular arc that
smoothly joins one end of a trapezoid. Works fine in Excel 2003, but
not in 2007.
I'll be glad to provide the spreadsheet with the completed drawing.
Sub macro1()
rn = 0.1 * 3
theta = 75
rf = 0.096592583 * 3
rb = 0.364541775060029 * 3
lgth = 1 * 3
Call DrArc(100, 300, rn, theta, newlft, nm1)
lft = newlft
Call DrTrap(lft, 300, rf, lgth, rb, newlft, nm2)
End Sub
Sub DrArc(lft, mid1, r, thet, newlft, nm1)
'
r1 = 72 * r
rad = Atn(1) / 45
a1 = thet * rad
h1 = r1 * Sin(a1)
w1 = r1 * (1 - Cos(a1))
ActiveSheet.Shapes.AddShape(msoShapeArc, lft, mid1 - h1, r1, 2 *
h1).Select
Selection.ShapeRange.Adjustments.Item(1) = thet
Selection.ShapeRange.Adjustments.Item(2) = -thet
Selection.ShapeRange.Flip msoFlipHorizontal
Selection.ShapeRange.Height = 2 * h1
Selection.ShapeRange.Width = r1
nm1 = Selection.Name
Selection.Top = mid1 - h1
Selection.Left = lft
newlft = lft + w1
Call Grad_Fill(9)
End Sub
Sub Grad_Fill(kolor)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = kolor
Selection.ShapeRange.Fill.OneColorGradient msoGradientHorizontal,
4, 0.23
End Sub
Sub DrTrap(lft, mid1, rf, lng, rb, newlft, nm1)
l1 = 72 * lng
r1 = 72 * Application.WorksheetFunction.Min(rf, rb)
r2 = 72 * Application.WorksheetFunction.Max(rf, rb)
ActiveSheet.Shapes.AddShape(msoShapeTrapezoid, lft, mid1 - r2, 2 *
r2, l1). _
Select
Selection.ShapeRange.IncrementRotation 90#
If rf > rb Then Selection.ShapeRange.Flip msoFlipHorizontal
Selection.ShapeRange.Adjustments.Item(1) = (1 - r1 / r2) / 2
nm1 = Selection.Name
Call Grad_Fill(9)
Selection.Top = mid1 - r2
Selection.Left = lft
newlft = lft + l1
End Sub