Error Checking in Excel
Thanks Thanks:  0
Likes Likes:  0
Results 1 to 6 of 6

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

  1. #1
    Board Regular
    Join Date
    Mar 2002
    Location
    Cincinnati, Ohio, USA
    Posts
    6,824
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

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

    Thanks,
    Tom

  2. #2
    MrExcel MVP
    Join Date
    Feb 2002
    Location
    Millbank, London, UK
    Posts
    1,790
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hey Tom,

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

    a veritable smorgassboard of links here


    :: Pharma Z - Family drugstore ::

  3. #3
    Board Regular
    Join Date
    Mar 2002
    Location
    Cincinnati, Ohio, USA
    Posts
    6,824
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Thanks Chris

  4. #4
    MrExcel MVP Joe Was's Avatar
    Join Date
    Feb 2002
    Location
    Central Florida, USA
    Posts
    7,539
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default

    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 ]

  5. #5
    Board Regular
    Join Date
    Mar 2002
    Posts
    51
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

  6. #6
    Board Regular
    Join Date
    Mar 2002
    Location
    Cincinnati, Ohio, USA
    Posts
    6,824
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Thanks Andy

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •