Sub DrawClock()
Dim i As Integer
Dim j As Integer
Dim r As Integer
Dim pi As Double
Dim ang As Double
Dim x As Double
Dim y As Double
'設定圓心座標及半徑
r = 100
x = 150
y = 150
'取得當前時間
h = Hour(Now)
m = Minute(Now)
s = Second(Now)
'清除舊時鐘
On Error Resume Next '防止第一次沒有資料可刪會錯誤中斷
ActiveSheet.Shapes.Range(Array("Clock")).Delete
'繪製時鐘圓形
Set myshape = ActiveSheet.Shapes.AddShape(msoShapeOval, x - r, y - r, 2 * r, 2 * r)
myshape.Name = "Clock"
myshape.Line.ForeColor.RGB = RGB(0, 0, 0)
'繪製時鐘刻度
pi = 3.14159265359
For i = 1 To 12
ang = pi / 6 * (i - 3)
x1 = x + r * Cos(ang)
y1 = y + r * Sin(ang)
x2 = x + (r - 10) * Cos(ang)
y2 = y + (r - 10) * Sin(ang)
Set myshape = ActiveSheet.Shapes.AddLine(x1, y1, x2, y2)
myshape.Line.Weight = 2
myshape.Line.ForeColor.RGB = RGB(0, 0, 0)
Next i
'繪製時針
ang = pi / 6 * (h - 3) + pi / 360 * m + pi / 21600 * s
x1 = x
y1 = y
x2 = x + (r - 50) * Cos(ang)
y2 = y + (r - 50) * Sin(ang)
Set myshape = ActiveSheet.Shapes.AddLine(x1, y1, x2, y2)
myshape.Line.Weight = 4
myshape.Line.ForeColor.RGB = RGB(255, 0, 0)
'繪製分針
ang = pi / 30 * (m - 15) + pi / 1800 * s
x1 = x
y1 = y
x2 = x + (r - 30) * Cos(ang)
y2 = y + (r - 30) * Sin(ang)
Set myshape = ActiveSheet.Shapes.AddLine(x1, y1, x2, y2)
myshape.Line.Weight = 3
myshape.Line.ForeColor.RGB = RGB(0, 255, 0)
'繪製秒針
ang = pi / 30 * (s - 15)
x1 = x
y1 = y
x2 = x + (r - 20) * Cos(ang)
y2 = y + (r - 20) * Sin(ang)
Set myshape = ActiveSheet.Shapes.AddLine(x1, y1, x2, y2)
myshape.Line.Weight = 1.5
myshape.Line.ForeColor.RGB = RGB(0, 0, 255)