Hands On Code

This code follows the clock face code.  It also makes use of the pif() function, my local version of Pi() or Application.WorksheetFunction.Pi().

' Draw the hands
'                                                (Left    Top     Width  Height)
    ActiveSheet.Shapes.AddShape(msoShapeDiamond, xCenter - MinHandWid / 2, YCenter - MinHandLen, MinHandWid, MinHandLen). _
        Select
    Selection.ShapeRange.Name = "Minute"
    ActiveSheet.Shapes.AddShape(msoShapeDiamond, xCenter - HrHandWid / 2, YCenter - HrHandLen, HrHandWid, HrHandLen). _
        Select
    Selection.ShapeRange.Name = "Hour"
'    For tick = 1 To 720
    ThisTime = Now()
    thishour = Hour(ThisTime)
    ClockHour = thishour Mod 12
    ThisMinute = Minute(ThisTime)
    tick = ThisMinute + 60 * ClockHour
    MAngle = 2 * Pi * (tick / 60)
    HAngle = 2 * Pi * (tick / (60 * 12))
    MDegrees = 6 * tick
    HDegrees = 6 * (tick / 12)
    ActiveSheet.Shapes("Minute").Select
' Rotate first to determine where new bounding box will be
    Selection.ShapeRange.Rotation = MDegrees
' use the bounding box to determine where the object
' center is
    ShapeLeft = Selection.Left
    ShapeTop = Selection.Top
    ShapeWidth = Selection.Width
    ShapeHeight = Selection.Height
    MinuteHandLength = Sqr(ShapeHeight * ShapeHeight + ShapeWidth * ShapeWidth)
    ShapeCenterY = ShapeTop + (ShapeHeight / 2)
    ShapeCenterX = ShapeLeft + (ShapeWidth / 2)
' determine where the end is
    pivotY = ShapeCenterY + Cos(MAngle) * MinuteHandLength / 2
    pivotX = ShapeCenterX - Sin(MAngle) * MinuteHandLength / 2
' determine distance to desired location
    shiftY = YCenter - pivotY
    shiftX = xCenter - pivotX
' shift the shape as required
    Selection.Left = ShapeLeft + shiftX
    Selection.Top = ShapeTop + shiftY
' do hourhand
    ActiveSheet.Shapes("Hour").Select
' Rotate first to determine where new bounding box will be
    Selection.ShapeRange.Rotation = HDegrees
' use the bounding box to determine where the object
' center is
    ShapeLeft = Selection.Left
    ShapeTop = Selection.Top
    ShapeWidth = Selection.Width
    ShapeHeight = Selection.Height
    HourHandLength = Sqr(ShapeHeight * ShapeHeight + ShapeWidth * ShapeWidth)
    ShapeCenterY = ShapeTop + (ShapeHeight / 2)
    ShapeCenterX = ShapeLeft + (ShapeWidth / 2)
' determine where the end is
    pivotY = ShapeCenterY + Cos(HAngle) * HourHandLength / 2
    pivotX = ShapeCenterX - Sin(HAngle) * HourHandLength / 2
' determine distance to desired location
    shiftY = YCenter - pivotY
    shiftX = xCenter - pivotX
' shift the shape as required
    Selection.Left = ShapeLeft + shiftX
    Selection.Top = ShapeTop + shiftY
    Range("A1").Select
Application.ScreenUpdating = True
  '  Next tick
    Range("A1").Select

 End Sub

Leave a Reply

This site uses Akismet to reduce spam. Learn how your comment data is processed.