Adding shapes to a range in VBA with Excel is actually a trivial task, if you are aware of the Shapes.AddShape method. It has 5 parameters, 4 of which could be pretty easily remapped to the parameters of the range:
- Left – The position (in points) of the upper-left corner of the AutoShape’s bounding box relative to the upper-left corner of the document.
- Top – The position (in points) of the upper-left corner of the AutoShape’s bounding box relative to the upper-left corner of the document.
- Width – The width of the AutoShape’s bounding box, in points.
- Height – The height of the AutoShape’s bounding box, in points.
So, once we get a range that we want to add a shape to, the following method could be used:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
Sub RangeToShape(myRange As Range, Optional customstyle As Long = 11) Dim posLeft As Long Dim posTop As Long Dim posWidth As Long Dim posHeight As Long Dim myShape As Shape posLeft = myRange.Left posTop = myRange.Top posWidth = myRange.Width posHeight = myRange.Height With myRange.Parent Set myShape = .Shapes.AddShape(msoShapeRectangle, posLeft, posTop, posWidth, posHeight) myShape.shapeStyle = customstyle End With End Sub |
With the usage of it, once a range is passed, a form covering that exact range is returned. In the example below, all the cells with some values in them are covered by a consecutively colored form:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
Option Explicit Sub Main() Dim myCell As Range Dim customstyle As Long: customstyle = 11 For Each myCell In Worksheets(1).Range("A1:Z20") If myCell.Value2 <> "" Then If customstyle > 15 Then customstyle = 11 RangeToShape myCell, customstyle customstyle = customstyle + 1 End If Next myCell End Sub |
This is the initial input:
And the result, after running the code looks like this:
Enjoy it! 🙂