| Home |
| Search |
| Today's Posts |
|
|
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
TopLeftCell change to "bottom"LeftCell
Hello,
I've got a macro (thanks to users here) that inserts a rectangle that fills a cell proportionally based on the contents of the cell. I would like to modify it so that the shape starts from the bottom and fills (top to bottom) proportionally. Here's the macro as it is now: Sub Proportionally_Fill() Dim c As Range Dim v As Single Dim s As Shape For Each c In Selection If c.Value = 0 And c.Value <= 1 Then v = c.Value Set s = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _ c.Left, c.Top, c.Width * v, c.Height) s.Fill.Visible = msoTrue s.Fill.ForeColor.SchemeColor = 17 s.Line.Visible = msoFalse Selection.Font.ColorIndex = 2 End If Next c End Sub I can get the overall shape centered, but haven't a clue how to get the shape to start at the bottom. Thanks in advance, MJohn |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
TopLeftCell change to "bottom"LeftCell
Sub Proportionally_Fill()
Dim c As Range Dim v As Single Dim s As Shape Dim x For Each c In Selection If c.Value = 0 And c.Value <= 1 Then v = c.Value x = v * c.Height Set s = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _ c.Left, (c.Top + c.Height) - x, c.Width, x) s.Fill.Visible = msoTrue s.Fill.ForeColor.SchemeColor = 17 s.Line.Visible = msoFalse Selection.Font.ColorIndex = 2 End If Next c End Sub -- Tim Williams Palo Alto, CA "M John" wrote in message ... Hello, I've got a macro (thanks to users here) that inserts a rectangle that fills a cell proportionally based on the contents of the cell. I would like to modify it so that the shape starts from the bottom and fills (top to bottom) proportionally. Here's the macro as it is now: Sub Proportionally_Fill() Dim c As Range Dim v As Single Dim s As Shape For Each c In Selection If c.Value = 0 And c.Value <= 1 Then v = c.Value Set s = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _ c.Left, c.Top, c.Width * v, c.Height) s.Fill.Visible = msoTrue s.Fill.ForeColor.SchemeColor = 17 s.Line.Visible = msoFalse Selection.Font.ColorIndex = 2 End If Next c End Sub I can get the overall shape centered, but haven't a clue how to get the shape to start at the bottom. Thanks in advance, MJohn |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
TopLeftCell change to "bottom"LeftCell
Thanks again. You've been a star.
Most appreciated. MJohn "Tim Williams" wrote: Sub Proportionally_Fill() Dim c As Range Dim v As Single Dim s As Shape Dim x For Each c In Selection If c.Value = 0 And c.Value <= 1 Then v = c.Value x = v * c.Height Set s = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _ c.Left, (c.Top + c.Height) - x, c.Width, x) s.Fill.Visible = msoTrue s.Fill.ForeColor.SchemeColor = 17 s.Line.Visible = msoFalse Selection.Font.ColorIndex = 2 End If Next c End Sub -- Tim Williams Palo Alto, CA "M John" wrote in message ... Hello, I've got a macro (thanks to users here) that inserts a rectangle that fills a cell proportionally based on the contents of the cell. I would like to modify it so that the shape starts from the bottom and fills (top to bottom) proportionally. Here's the macro as it is now: Sub Proportionally_Fill() Dim c As Range Dim v As Single Dim s As Shape For Each c In Selection If c.Value = 0 And c.Value <= 1 Then v = c.Value Set s = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _ c.Left, c.Top, c.Width * v, c.Height) s.Fill.Visible = msoTrue s.Fill.ForeColor.SchemeColor = 17 s.Line.Visible = msoFalse Selection.Font.ColorIndex = 2 End If Next c End Sub I can get the overall shape centered, but haven't a clue how to get the shape to start at the bottom. Thanks in advance, MJohn |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
TopLeftCell change to "bottom"LeftCell
No problem - I will most likely use it myself one day...
-- Tim Williams Palo Alto, CA "M John" wrote in message ... Thanks again. You've been a star. Most appreciated. MJohn "Tim Williams" wrote: Sub Proportionally_Fill() Dim c As Range Dim v As Single Dim s As Shape Dim x For Each c In Selection If c.Value = 0 And c.Value <= 1 Then v = c.Value x = v * c.Height Set s = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _ c.Left, (c.Top + c.Height) - x, c.Width, x) s.Fill.Visible = msoTrue s.Fill.ForeColor.SchemeColor = 17 s.Line.Visible = msoFalse Selection.Font.ColorIndex = 2 End If Next c End Sub -- Tim Williams Palo Alto, CA "M John" wrote in message ... Hello, I've got a macro (thanks to users here) that inserts a rectangle that fills a cell proportionally based on the contents of the cell. I would like to modify it so that the shape starts from the bottom and fills (top to bottom) proportionally. Here's the macro as it is now: Sub Proportionally_Fill() Dim c As Range Dim v As Single Dim s As Shape For Each c In Selection If c.Value = 0 And c.Value <= 1 Then v = c.Value Set s = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _ c.Left, c.Top, c.Width * v, c.Height) s.Fill.Visible = msoTrue s.Fill.ForeColor.SchemeColor = 17 s.Line.Visible = msoFalse Selection.Font.ColorIndex = 2 End If Next c End Sub I can get the overall shape centered, but haven't a clue how to get the shape to start at the bottom. Thanks in advance, MJohn |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Turn off "CALCULATE" on bottom of Excel worksheet. near "Ready" | Excel Discussion (Misc queries) | |||
| How do I change the column heading in Excel to display "A" "B" "C | New Users to Excel | |||
| change "true" and "false" to "availble" and "out of stock" | Excel Worksheet Functions | |||
| =IF(D13="PAID","YES","NO") Can I change fonts colour | Excel Discussion (Misc queries) | |||
| Adding "New" "Insert" "Delete" into a workbook to change from data 1 to data 2 etc | Excel Programming | |||
Hybrid Mode
