Everyone... Know of any good sites to download examples of

[Legacy 98055]

I am delving into some of the graphics capabilities in Excel and would like to see some other ideas...

Thanks,
Tom

 

[Chris Davison]

Hey Tom,

http://www.mvps.org/dmcritchie/excel/excel.htm

a veritable smorgassboard of links here

 

[Legacy 98055]

Thanks Chris

 

[Joe Was]

This will draw a triangle based upon the values in C9,10,11 and indicate the area in C13. The values should be 0.1 to about 4, to fit on the sheet. JSW

Sub DrawP()
Dim x1, x2, x3, y1, y2, y3

x1 = Range("N2")
y1 = Range("O2")
x2 = Range("N3")
y2 = Range("O3")
x3 = Range("N4")
y3 = Range("O4")
Range("A1").Select
On Error GoTo Err
Set myDocument = Worksheets(1)
myDocument.Shapes.SelectAll
Selection.Cut
With myDocument.Shapes.BuildFreeform(msoEditingCorner, x1, y1)
.AddNodes msoSegmentLine, msoEditingAuto, x2, y2
.AddNodes msoSegmentLine, msoEditingAuto, x3, y3
.AddNodes msoSegmentLine, msoEditingAuto, x1, y1
.ConvertToShape
End With
myDocument.Shapes.SelectAll
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 43
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 2#
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)

ActiveSheet.Buttons.Add(80.25, 192.75, 90, 27.75).Select
Selection.OnAction = "DrawP"
Selection.Characters.Text = "Calculate"
With Selection.Characters(Start:=1, Length:=9).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 9
End With
ActiveSheet.Buttons.Add(353.25, 57, 54, 16.5).Select
Selection.OnAction = "myReSet"
Selection.Characters.Text = "ReSet"
With Selection.Characters(Start:=1, Length:=5).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 9
End With
Range("A1").Select
'With myDocument.Shapes(1)
' vertArray = .Vertices
' x1 = vertArray(1, 1)
' y1 = vertArray(1, 2)
' MsgBox "First vertex coordinates: " & x1 & ", " & y1
'End With
End
Err:
ActiveSheet.Buttons.Add(80.25, 192.75, 90, 27.75).Select
Selection.OnAction = "DrawP"
Selection.Characters.Text = "Calculate"
With Selection.Characters(Start:=1, Length:=9).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 9
End With
ActiveSheet.Buttons.Add(353.25, 57, 54, 16.5).Select
Selection.OnAction = "myReSet"
Selection.Characters.Text = "ReSet"
With Selection.Characters(Start:=1, Length:=5).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 9
End With
Range("A1").Select
'With myDocument.Shapes(1)
' vertArray = .Vertices
' x1 = vertArray(1, 1)
' y1 = vertArray(1, 2)
' MsgBox "First vertex coordinates: " & x1 & ", " & y1
'End With
End Sub
Sub myReSet()
Set myDocument = Worksheets(1)
myDocument.Shapes.SelectAll
Selection.Cut
Range("C9").Select
ActiveCell.FormulaR1C1 = "0"
Range("C10").Select
ActiveCell.FormulaR1C1 = "0"
Range("C11").Select
ActiveCell.FormulaR1C1 = "0"
ActiveSheet.Buttons.Add(80.25, 192.75, 90, 27.75).Select
Selection.OnAction = "DrawP"
Selection.Characters.Text = "Calculate"
With Selection.Characters(Start:=1, Length:=9).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 9
End With
ActiveSheet.Buttons.Add(353.25, 57, 54, 16.5).Select
Selection.OnAction = "myReSet"
Selection.Characters.Text = "ReSet"
With Selection.Characters(Start:=1, Length:=5).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 9
End With
Range("A1").Select
End Sub

The required sheet formulas are:

I1: Point3x
I2: =((C9*C9)+(C11*C11)-(C10*C10))/2*C11
J1: Point3y
J2: =SQRT((C9*C9)-(I2*I2))
K1: Area
K2: =C11*J2/2
L1: X
L2: 0
L3: 0
L4: =I2
M1: Y
M2: 0
M3: 0
M4: =J2
N1: NodeX
N2: =INT((L2*100)+P2)
N3: =INT((L3*100)+P2)
N4: =INT((L4*100)+P2)
O1: NodeY
O2: =INT((M2*100)+Q2)
O3: =INT((M3*100)+Q2)
O4: =INT((M4*100)+Q2)
P1: StartPosX
P2: 200
Q1:StartPosY
Q2: 100
B18: =IF(ISERROR(C13)=TRUE," Try a smaller length!","")

B19: =IF(AND(OR(C9+C10<=C11,C9+C11<=C10,C11+C10<=C9)*C9+C10+C11=0)," Note: A triangle of zero area cannot be calculated!",IF(OR(C9+C10<=C11,C9+C11<=C10,C11+C10<=C9)," Note: The length of one side must be less than the sum of the other two sides."," Note:"))
C13: =K2

Sheet Lables:
B6: Enter the Length of the sides of
B7: a triangle in the boxes below!
B9: Side 1 =
B10: Side 2 =
B11: Side 3 =
B13: Area =

If you add all this to Sheet1 and copy the Macros to Module1 and run the code once the macro buttons will be drawn automatically, hit Re-Set and add your test lengths. The Calculate button will draw the resulting triangle. JSW
This message was edited by Joe Was on 2002-04-26 23:59
This message was edited by Joe Was on 2002-04-27 00:04

 

[andy-s]

Try

http://www.erlandsendata.no/english/downloads/charts.htm

http://edferrero.m6.net/

http://www.xl-logic.com/pages/charts.html

 

[Legacy 98055]

Thanks Andy