Membuat Jam Analog di Worksheet

Updated on October 9, 2023 . 3 min read

Setelah sebelumnya saya telah membuat jam digital pada worksheet. Kali ini saya coba buat jam analog yang ditampilkan pada worksheet.

Baca juga : Membuat jam digital di worksheet
vba.co.id

Pada prinsipnya untuk membuat jam analog ini masih sama dengan cara membuat jam digital, hanya saja pada jam analog ini ditambahkan beberapa script untuk membuat sebuah Shape berbentuk garis yang nantinya digunakan sebagai penunjuk jam, menit dan detik.

Hasil dari jam analog bisa dilihat dibawah ini.

Untuk membuat jam analog seperti ini, buat 2 tombol yaitu untuk Start dan juga tombol Stop

Simpan script ini pada tombol Star

Sub BtPlay_Click()

On Error Resume Next
    
'Delete Jarum
Sheet1.Shapes.Range(Array("sh3", "mh3", "hh3")).Delete

x1 = 250
x2 = 250
y1 = 155

Sy2 = 60
S1y2 = 250

My2 = Sy2 + 20
M1y2 = S1y2 - 20

Hy2 = Sy2 + 40
H1y2 = S1y2 - 40

'Detik
With Sheet1.Shapes.AddLine(x1, y1, x2, Sy2).Line
    .Parent.Name = "sh1"
    .ForeColor.RGB = RGB(89, 89, 89)
End With
       
With Sheet1.Shapes.AddLine(x1, y1, x2, S1y2).Line
    .Parent.Name = "sh2"
    .Visible = False
End With
        
With Sheet1.Shapes.Range(Array("sh1", "sh2")).Group
    .Name = "sh3"
    .Shadow.Type = msoShadow21
End With

'Menit
With Sheet1.Shapes.AddLine(x1, y1, x2, My2).Line
    .Parent.Name = "mh1"
    .Weight = 1
    .ForeColor.RGB = RGB(49, 134, 155)
    .EndArrowheadStyle = msoArrowheadTriangle
End With

With Sheet1.Shapes.AddLine(x1, y1, x2, M1y2).Line
    .Parent.Name = "mh2"
    .Visible = False
End With
        
With Sheet1.Shapes.Range(Array("mh1", "mh2")).Group
    .Name = "mh3"
    .Shadow.Type = msoShadow21
End With
        
'Jam
With Sheet1.Shapes.AddLine(x1, y1, x2, Hy2).Line
    .Parent.Name = "hh1"
    .Weight = 1.25
    .ForeColor.RGB = RGB(0, 176, 80)
    .EndArrowheadStyle = msoArrowheadTriangle
End With
    
With Sheet1.Shapes.AddLine(x1, y1, x2, H1y2).Line
    .Parent.Name = "hh2"
    .Visible = False
End With
    
With Sheet1.Shapes.Range(Array("hh1", "hh2")).Group
    .Name = "hh3"
    .Shadow.Type = msoShadow21
End With

Call JalanJam

End Sub

Dan simpan script dibawah ini pada tombol Stop

Sub BTStop_Click()
On Error Resume Next
Application.OnTime Now + TimeValue("00:00:01"), "JalanJam", , False
End Sub

Setelah itu simpan juga script ini untuk menjalankan Jamnya

Sub CurrentTime()
On Error Resume Next
    SecHand = Second(Now()) * 6
    Minhand = Minute(Now()) * 6
    HrHand = (Hour(Now()) * 30) + Int(Minhand / 10)
    Sheet1.Shapes("sh3").Rotation = SecHand
    Sheet1.Shapes("mh3").Rotation = Minhand
    Sheet1.Shapes("hh3").Rotation = HrHand
End Sub

Sub JalanJam()
Dim Sh As Worksheet
Set Sh = Sheet1

With Sh.Range("E18")
    .Value = Now
    .NumberFormat = "hh:mm:ss AM/PM"
End With
Application.OnTime Now + TimeValue("00:00:01"), "JalanJam", , True
Call CurrentTime

End Sub

Jam analog sudah selsai dibuat, jangan lupa setiap akan menutup file ini tekan tombol stop terlebih dahulu agar script nya berhenti bekerja.