Scaled triangle

Question

In Excel I would like to draw a right triangle shape using what I call a "scale".  For example, if I wish to simulate a roof slope of a run of 4 and a rise of 1, the triangle would be created with a 1:4 slope.  If I change the rise to 1.25 the triangle would re-draw to the new shape.

Answer 1

Hi

Have a look at this link: http://cjoint.com/?BCBqQsHA1rV

It's a bit different from Bernie, It's scale to the background grid.

Your choice.

Cimjet

Answer 2

Name three cells: Rise, Run, and Base - Base will the the cell where the triangle is drawn, and the width of the column that Base is in will set the scaling of the triangle. Enter 1 into the cell Rise, and 4 into cell Run.

Then copy this code into a regular codemodule:

Sub ShowRoof()

Dim myC As Range

Set myC = Selection

On Error Resume Next

ActiveSheet.Shapes("Roof").Delete

    ActiveSheet.Shapes.AddShape(msoShapeRightTriangle, _

    Range("Base").Left, _

    Range("Base").Top - Range("Base").Width + Range("Base").Height, _

    Range("Base").Width, _

    Range("Base").Width).Select

    Selection.Name = "Roof"

    Selection.ShapeRange.Flip msoFlipHorizontal

    Selection.ShapeRange.ScaleHeight _

        Range("Rise").Value / Range("Run").Value, _

        msoFalse, msoScaleFromBottomRight

    myC.Select

End Sub

Finally, copy this code, right-click the sheet tab, select "View Code" and paste the code into the window that appears.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub

On Error Resume Next

If Target.Name.Name = "Rise" Or Target.Name.Name = "Run" Then ShowRoof

End Sub

Then enter new values into the cells named Rise or Run, and the trangle will scale as appropriate.

If you cannot get the code to work, contact me at 

 bdeitrick at alum dot mit dot edu

and I will send you a working version.

If you want to show a gable end of the roof, you can use this version:

Sub ShowRoof()

    Dim myC As Range

    Set myC = Selection

    On Error Resume Next

    ActiveSheet.Shapes("RoofL").Delete

    ActiveSheet.Shapes.AddShape(msoShapeRightTriangle, _

        Range("Base").Left, _

        Range("Base").Top - Range("Base").Width + Range("Base").Height, _

        Range("Base").Width, _

        Range("Base").Width).Select

    Selection.Name = "RoofL"

    Selection.ShapeRange.Flip msoFlipHorizontal

    Selection.ShapeRange.ScaleHeight _

            Range("Rise").Value / Range("Run").Value, _

            msoFalse, msoScaleFromBottomRight

    myC.Select

    ActiveSheet.Shapes("RoofR").Delete

    ActiveSheet.Shapes.AddShape(msoShapeRightTriangle, _

        Range("Base").Left + Range("Base").Width, _

        Range("Base").Top - Range("Base").Width + Range("Base").Height, _

        Range("Base").Width, _

        Range("Base").Width).Select

    Selection.Name = "RoofR"

    Selection.ShapeRange.ScaleHeight _

            Range("Rise").Value / Range("Run").Value, _

            msoFalse, msoScaleFromBottomRight

    myC.Select

End Sub

Bernie

Answer 3

Thanks for the feedback

Come back to see us anytime if you need help.

Cimjet

Answer 4

This works as well!  This is my first time on MS Answers and i am very much impressed, not only with the response time, but with the eloquence of the solutions, too.