Draw triangle that changes size depending on cell values.

**alasdairfraser** · 07-17-2010, 07:32 PM

Wouldn't know what VBA was if it knocked down and killed me, lumbered with Openoffice at home, so, if at all possible, could you post an worksheet with the solution embedded? I am genuinely sorry, and will learn VBA, just not this weekend.
----------
Excel 2000; w2000p
---------
I'd like to draw a right-angled triangle, anchored [not changing position within the worksheet] on the right angle, which changes side length depending on cell values entered for two or three of [height, base, hypotenuse].
So, for values 120 and 20, in cells a1 and a2, need to produce a 120*20 pt triangle, area 1200sqpts.

I am aware of ways to do something similar using conditional formatting, but it's the triangle I need for a printed infographic.

I am also aware that you can resize a triangle manually/use charts. However this is impractical given that the output is a diagram with a grid of 48 triangles, expected to alter fast depending on variables elsewhere in the spreadsheet, and charts need resizing anyway to preserve scale.

Many thanks for your time.

**mikerickson** · 07-17-2010, 08:39 PM

How about this?

Enter the horizontal and vertical sides in A1 and A2.
(The length of the hypotenuse is automatically calculated in A3)
Enter the scale of the drawing in A5.
Press the button and the triangle will be drawn by this sub

Sub makeTriangle()
    Dim Horiz As Double, Vert As Double
    Dim cornerTop As Double, cornerLeft As Double
    On Error GoTo Halt
    With ThisWorkbook.Sheets("Sheet1")
        Horiz = Val(CStr(.Range("A1").Value)) * Val(CStr(.Range("A5").Value))
        Vert = Val(CStr(.Range("A2").Value)) * Val(CStr(.Range("A5").Value))
        cornerTop = .Range("D2").Top
        cornerLeft = .Range("D2").Left
        
        With .Shapes("Line 1"): Rem horizontal
            .Top = cornerTop
            .Left = cornerLeft
            .Height = 0
            .Width = Horiz
        End With
        
        With .Shapes("Line 2"): Rem vertical
            .Top = cornerTop
            .Left = cornerLeft
            .Height = Vert
            .Width = 0
        End With
        
        With .Shapes("Line 3"): Rem hypotinuse
            .Top = cornerTop
            .Left = cornerLeft
            .Height = Vert
            .Width = Horiz
        End With
    End With
Halt:
    On Error GoTo 0
End Sub

**alasdairfraser** · 07-18-2010, 11:24 AM

Many thanks for this. I've had a play around, and while it's great for drawing one triangle, it doesn't seem to want to draw two.

The two ways I've tried it are:
1)
Adding a separate macro, Maketriangle1 (), and executing in a group macro. In this instance, it leaves only the three lines with the three lowest x values [1,2,3] of the .Shapes("Line x") arguments.

The funny thing is, you can see Excel drawing both triangles before it wipes one away. I've tried messing about with the Static command, but it still leaves just one triangle drawn.

I renamed all of the defined variables and cell references. Can the .Shapes() command only draw one thing at once?

2)
Same as above, but adding more commands under the same macro. Now it draws nothing!

Also, is there any way to add a fill color/colour to the shape?

Many thanks for your help.

**mikerickson** · 07-18-2010, 01:15 PM

Excel is not a graphics package. If you have a fixed number of triangles, they can be created with the Draw capabilities. But if for creating and moving them on the fly, Excel is not the program for the task.

**alasdairfraser** · 07-19-2010, 04:53 PM

I'm not wanting to move them, or change the number of them at on. I want to alter their sizes on the fly [I have Illustrator for drawing things with].

My problem is just with creating a fixed number of triangles greater than one. I haven't been able to draw two working triangles given my adaptations to the code, kindly supplied previously.

Many thanks,

**mikerickson** · 07-19-2010, 05:32 PM

If you could post a copy of your workbook, it might help me understand what you are looking for.
If you have existing triangles, calculating the coordinates of the end-points is pretty straight forward.
Applying those coordinates to the triangles is heavily dependent on how your triangles are made (3 line segments or a closed curve or ... ) and how they are named.

**alasdairfraser** · 07-19-2010, 07:04 PM

Thanks, attached.

**lecxe** · 07-19-2010, 10:23 PM

Hi

To draw a right triangle you can also use the RightTriangle shape.

For ex.:

Sub DrawRightTriangle(sName As String, dLeft As Double, dTop As Double, dWidth As Double, dHeight As Double)
Dim shp As Shape

Set shp = ActiveSheet.Shapes.AddShape(msoShapeRightTriangle, dLeft, dTop, dWidth, dHeight)
shp.Name = sName
End Sub

A test to create your 120*20 triangle

DrawRightTriangle "RightTriangle01", 50, 100, 20,120

You can use a loop that calls DrawRightTriangle to create your 48 triangles.
You know their name so they will be easy to manipulate.

To fill the shape with a color you can add to the procedure, for ex.: