Two parts, the clock face code (including some required functions) in this post and next the Hands in a later post.
Here is the code that generates the clock face:
Sub Clock2()
' this code will draw a Clock
' Sheets.Add
Application.ScreenUpdating = False
' determine the size of the window
WindowHeight = ActiveWindow.UsableHeight
WindowWidth = ActiveWindow.UsableWidth
' determine the diameter of the potential clock face
Diameter = minf(WindowHeight, WindowWidth)
' find the center point of the usable area
xCenter = WindowWidth / 2
YCenter = WindowHeight / 2
' calculate pi (should be built in but cannot find)
Pi = pif()
' calculate some esthetic constants
TextWidth = Diameter / 12
TextHeight = TextWidth
TextSize = 2 + Int(TextWidth / 2)
TW2 = TextWidth / 2
TH2 = TextHeight / 2
TW3 = TextWidth / 3
TH3 = TextHeight / 3
' set the value of the minute hand
MinHandWid = TW2 / 2
MinHandLen = Diameter / 4
' set the value of the hour hand
HrHandWid = TW3
HrHandLen = Diameter / 6
' Draw the face
For tick = 0 To 59
Angle = 2 * Pi * tick / 60
Degrees = 6 * tick
sina = Sin(Angle)
cosa = Cos(Angle)
y = WindowHeight / 2 - Cos(Angle) * Diameter / 4
x = WindowWidth / 2 + Diameter / 4 * Sin(Angle)
If Int(tick / 5) = tick / 5 Then LineLen = 8 Else LineLen = 5
ActiveSheet.Shapes.AddLine(x, y, x, y + LineLen).Select
Selection.ShapeRange.Rotation = Degrees
If Int(tick / 5) = tick / 5 Then
' draw text box and label
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, x - TW2 + TW2 * sina, y - TH2 - TW2 * cosa, _
TextWidth, TextHeight).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.ReadingOrder = xlContext
.Orientation = xlHorizontal
.AutoSize = False
.ShapeRange.Fill.Visible = msoFalse
.ShapeRange.Fill.Solid
.ShapeRange.Fill.Transparency = 1#
.ShapeRange.Line.Weight = 0.75
.ShapeRange.Line.DashStyle = msoLineSolid
.ShapeRange.Line.Style = msoLineSingle
.ShapeRange.Line.Transparency = 0#
.ShapeRange.Line.Visible = msoFalse End With
If tick > 0 Then _ Selection.Characters.Text = Format(Int(tick / 5), "#") Else _
Selection.Characters.Text = Format(12, "#")
With Selection.Characters(Start:=1, Length:=2).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = TextSize
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
End If
Range("A1").Select
Next tick
You will also need these function calls if they are not included in your VBA:
' maxf - max of 2 numbers ' minf - min of 2 numbers ' pif - pi Function pif() pif = 3.14159265359 End Function Function maxf(a, b) If a > b Then Max = a Else Max = b End Function Function minf(a, b) If a < b Then minf = a Else Min = b End Function
The hands code will be in the second following post.