Hello,
I stumbled across the following code somewhere... the code uses the radius of a circle and the dimension of a square to tell you how many squares you can fit inside the circle and then draws the circle and array of squares in the spreadsheet. I really need to do the opposite. I want to provide the size of the square and number of squares and calculate the area of the circle that is needed. Anyone know how to modify this code to make it happen? Thanks in advance!
I stumbled across the following code somewhere... the code uses the radius of a circle and the dimension of a square to tell you how many squares you can fit inside the circle and then draws the circle and array of squares in the spreadsheet. I really need to do the opposite. I want to provide the size of the square and number of squares and calculate the area of the circle that is needed. Anyone know how to modify this code to make it happen? Thanks in advance!
Code:
[COLOR=#242729][FONT=Consolas]Option Explicit[/FONT][/COLOR]<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; white-space: inherit;">
Sub addShapeDemo()
Dim shape As Excel.shape
Dim x As Single
Dim y As Single
Dim mx As Single
Dim my As Single
Dim col As Integer
Dim cols As Integer
Dim row As Integer
Dim rows As Integer
Dim d2 As Single
Dim xMin As Single
Dim yMin As Single
Dim squares As Integer
Const radius = 120.3964 ' results in 341 squares
Const a = 11 ' square dimension
mx = 600 ' center of the circle
my = 600
' clean our sheet from previous drawings
On Error Resume Next
ActiveSheet.DrawingObjects.Delete
' draw the circle nicely colored
Set shape = ActiveSheet.Shapes.AddShape(msoShapeOval, Left:=mx - radius, _
Top:=my - radius, Width:=2 * radius, _
Height:=2 * radius)
shape.Select
Selection.ShapeRange.Fill.Visible = msoFalse
With Selection.ShapeRange.Line
.ForeColor.RGB = RGB(255, 0, 0)
.Weight = 2.25
End With
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 0)
End With
' draw the boxes
rows = (2 * radius) \ a
yMin = my - a * 0.5 * ((2 * rows) \ 2)
For row = 1 To rows
' find out how many columns to place
' outer corner must stay within our circle
y = yMin + (row - 1) * a
If row <= rows \ 2 Then
cols = (2# * ((radius * radius - (y - my) * (y - my)) ^ 0.5)) \ a
Else
cols = (2# * ((radius * radius - (y - my + a) * (y - my + a)) ^ 0.5)) \ a
End If
' center the line
xMin = mx - a * 0.5 * ((2 * cols) \ 2)
For col = 1 To cols
x = xMin + (col - 1) * a
ActiveSheet.Shapes.AddShape msoShapeRectangle, Left:=x, _
Top:=y, Width:=a, Height:=a
squares = squares + 1
Next col
Next row
MsgBox squares & " squares" </code>[COLOR=#242729][FONT=Consolas]End Sub[/FONT][/COLOR]