proportionally fill a cell
Option Explicit
Sub Macro1()
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 = 44
s.Fill.Transparency = 0.67
End If
Next c
End Sub
--
Tim Williams
Palo Alto, CA
"M John" wrote in message ...
Is this possible:
I'm looking for a way to proportionally fill a cell based on the contents.
For example, if the contents of four rows a
.8
.75
.5
1
then the contents of these cells are 4/5, 3/4, 1/2, and completely
full....(either top to bottom or left to right).
Right now I'm using a stacked bar graph, but lining up the axes of the graph
on top of the the cell gridlines is quite a challenge and very time
consuming. I'm not optimistic, but thought I would put this question out
here to check.
Many thanks in advance.
MJohn
|