Drawing Ovals In Specific Cells - Macro Run Only

[Mark56]

Good Day,

I am not new to programming in VB but it has been a while since I have been doing more than just the basic macro builds. I have been asked to try and add some Ovals around designated cells within a worksheet. I would like to run one Macro and have it draw several ovals over the designated cells.
Currently the workbook has macros that will draw designated lines from Point A to Point B. I have tried to modify that code but It just did not seem to be working for me as I had wanted.
Found a few example that would draw the an oval around a SELECTED cell but I want to do a drawing code that is called from another Sub with designated Cell to have the oval drawn around. What I want is this:

But the Code has me selecting the cell, but with about 40 of these to insert I would like to do it with a drawing Sub - End Sub and a designated Sub- End Sub. The code that draws the above is:

Sub A_DrawOval2()
'Updateby20141105
Dim Arng As Range
Dim WorkRng As Range
Set WorkRng = Application.Selection
For Each Arng In WorkRng.Areas
With Arng
x = Arng.Height * 0.1
y = Arng.Width * 0.1
Application.ActiveSheet.Ovals.Add Top:=.Top - x, Left:=.Left - y, _
Height:=.Height + 2 * x, Width:=.Width + 1.5 * y
With Application.ActiveSheet.Ovals(ActiveSheet.Ovals.Count)
.Interior.ColorIndex = xlNone
.ShapeRange.Line.Weight = 1.25
End With
End With
Next
WorkRng.Select
End Sub

I want to use some code like this to call the drawing routing, to designate the cell/cells to draw around:

Sub A_DrawNewOval1_0()
Call A_DrawOval(D4, 8, 10)
End Sub

I know that is is a poor example but as I said I have not done much in the way of more comlex VBA code in a long time.

Thank you for any help in this matter.

 

[mjbeam]

Can't you just use code to select the cells you want ovals around, then call your A_DrawOval2 sub?

 

[pgc01]

Hi Mark
Welcome to the board

In

Call A_DrawOval(D4, 8, 10)

I asume that D4 would be the cell reference (with a wrong format), but what are the 8 and the 10?

 

[Mark56]

Thank you for the responses.

I figured that I needed to supply the X & Y that would be used in the draw routine. That first cell 8, 10, should have been cell J8 not D4. I was trying to use the D4 just to see if it would draw in a blank cell. Sorry for any confusion.


Mark M.

 

[Mark56]

mjbeam,

I could not figure out a way to select just one cell. Most of the examples I was looking at was selecting a range not one specific cell.


Mark M.

 

[mjbeam]

mjbeam,

I could not figure out a way to select just one cell. Most of the examples I was looking at was selecting a range not one specific cell.


Mark M.

Cells(1, 1).Select

 

[pgc01]

Hi

This is an example of a code that draws an oval around a cell:

Sub A_DrawOval(rCell As Range)
Dim dHeightOff As Double, dWidthOff As Double
Dim ovl As Shape

dHeightOff = rCell.Height * 0.1
dWidthOff = rCell.Width * 0.1

With rCell
    Set ovl = ActiveSheet.Shapes.AddShape(msoShapeOval, _
        Top:=.Top - dHeightOff, Left:=.Left - dWidthOff, _
        Height:=.Height + 2 * dHeightOff, Width:=.Width + 1.5 * dWidthOff)
End With

With ovl
    .Fill.Visible = False
    .Line.Weight = 1.5
End With

End Sub

and this is a test, draws an oval around the cells D4, C2 and J3:

Sub test()
Dim r As Range, rCell As Range

Set r = Range("D4,C2,J3")

For Each rCell In r
    A_DrawOval rCell
Next rCell

End Sub

 

[Mark56]

I took what mjbeam said and reworked the original set of Sub -End-Sub routines and used the original DrawOval code to produce the overlayed ovals I needed. Code was as follows:

Sub DrawOval97()
ActiveSheet.Range("K98").Select
Call A_DrawOval
ActiveSheet.Range("K101").Select
Call A_DrawOval
ActiveSheet.Range("K104").Select
Call A_DrawOval
ActiveSheet.Range("K107").Select
Call A_DrawOval
End Sub

Thank you all for the suggestions and helping me get through the block I had.


Mark