Menampilkan jam dan tanggal - Coba ketikan pada sel mana saja rumus =NOW() kemudia tekan enter, maka sel tersebut akan menunjukan waktu sekarang, jika format pada sel adalah dd mmmm yyyy maka informasi yang muncul hanya tanggal sekarang, kemudian jika pada sel tersbut formatnya anda rubah menjadi mm:hh maka sel tersebut akan memberikan informasi jam sekarang. Sekarang bagaimana caranya menampilkan waktu baik berupa tanggal atau jam kedalam userform ? Simak baik baik caranya

Menampilkan Tanggal Sekarang kedalam Userform

Tidak usah banyak basi basa ya, karena saya akan memberikan beberapa cara menampilkan waktu dengan berbagai gaya atau model, cara menampilkan tanggal kedalam userform cukup ketikan kode macro sederhana ini kedalam Userform

Private Sub UserForm_Activate()
Me.Caption = Date
End Sub

Sekarang adalah tanggal 23 Agustus 2017, format tanggal yang akan ditampilkan dalam userform akan mengikuti format yang anda pakai dalam microsoft Excel anda, namun jika anda menginginkan format yang berbeda anda bisa menggantinya menjadi seperti ini

+ Format(Date, "dd mmmm yyyy") akan menampilakn tanggal 23 Agustus 2017
+ Format(Date, "dd-mm-yyyy") akan menampilakn tanggal 23-08-2017
+ Format(Date, "dddd dd mmmm yyyy") akan menampilakn tanggal Rabu 23 Agustus 2017, dan seterusnya

Menampilkan Jam Sekarang kedalam Userform (realtime)

Untuk menampilkan jam kedalam userform secara realtime ( mengikuti waktu sekarang ) caranya tidak akalh mudahnya, dan akan lebih menarik karena ada detik yang berjalan, bagaimana caranya, simak lagi yuuuuk

Dim Ckik As Boolean
Private Sub UserForm_Activate()
Do Until Ckik
Me.Caption = FormatDateTime(Time, vbLongTime)
DoEvents
Loop
End Sub
Private Sub UserForm_Terminate()
Ckik = True
End Sub

Coba ganti kode macro ini Me.Caption = FormatDateTime(Time, vbLongTime) menjadi Me.Caption = FormatDateTime(format(Time, "dd mmmm yyyy - MM:YY:DD, vbLongTime). saya akan perlihatkan screenshootnya dibawah ini


Download - Membuat Jam dengan Excel

Menampilkan Jam Sekarang kedalam Userform (Analog)

Bisakah menampilkan jam analog kedalam userform ? inilah yang membedakan asis10.com dengan blog Excel lainya :), kami senantiasa memberikan informasi terupdate terakurat termewah serta kami tidak menyembunyikan kode rahasia rahsiaan, semua yang saya ketahui akan saya tulis di asis10.com
Cara menampilkan jam analog kedalam userform juga tidak susah, bahkan sama mudahnya dengan cara menampilkan jam digital kedalam userform, mari kita simak lagi yuuuuk . . .


Kode macro yang digunakan kedalam userform hanya ini
Private nempeldinding As Jamdinding
Private Sub UserForm_Initialize()

Dim lngMinute As Long
Dim lngHour As Long

lngHour = Hour(Now())
lngMinute = Minute(Now())

Set nempeldinding = New Jamdinding
With nempeldinding
Set .Parent = Me
.OffsetX = Image1.Left
.OffsetY = Image1.Top
.OriginX = Image1.Width / 2
.OriginY = Image1.Height / 2
.Radius(enumClockHourHand) = Image1.Width / 4
.Radius(emnuClockMinuteHand) = Image1.Width / 3
.Color(enumClockHourHand) = RGB(50, 50, 255)
.Color(emnuClockMinuteHand) = RGB(50, 50, 255)
.SetTime = Now
End With

End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Set nempeldinding = Nothing
Me.Hide
End Sub

Karena dalam toolbox tidak ada kontol yang bisa membentuk lingkaran maka anda harus menyiapkan gambar dengan lingkaran, serta bantuan kontrol Image, gunakan image ini (Download Image jam analog), lalu insert kedalam kontrol Image1

Lalu buat modul dengan kode macro dibawah ini
Sub Main()
Dim frmTime As FTime

Set frmTime = New FTime
frmTime.Show

Unload frmTime
Set frmTime = Nothing

End Sub

Lalu buat Class modul dengan kode macro dibawah ini

Public Enum enumClock
enumClockHourHand = 1
emnuClockMinuteHand = 2
End Enum
Private Const PI = 3.14159265358979
Private Const mHOUR_PREFIX = "HrHand"
Private Const mMINUTE_PREFIX = "MnHand"
Public Parent As Object
Private m_GudangOrg As Single
Private m_KasirOrg As Single
Private m_iparengan As Single
Private m_ExcelVba As Single
Private m_Wrna1 As Collection
Private m_Wrna2 As Collection
Private m_Lengkok1() As Single
Private m_Lengkok2() As Single
Private m_datTime As Date
Public Property Let Color(Hand As enumClock, RHS As Long)
Dim lngItem As Long

If Hand = enumClockHourHand Then
For lngItem = 1 To m_Wrna1.Count
m_Wrna1.Item(lngItem).ForeColor = RHS
Next
Else
For lngItem = 1 To m_Wrna2.Count
m_Wrna2.Item(lngItem).ForeColor = RHS
Next
End If

End Property

Public Function GetTime() As Date
GetTime = m_datTime
End Function

Private Function m_AdjustTime(StartTime As Date, NewHour As Long, NewMinute As Long) As Date

m_AdjustTime = DateSerial(Year(StartTime), Month(StartTime), Day(StartTime)) + _
TimeSerial(NewHour, NewMinute, 0)

End Function

Public Property Let SetHour(ByVal RHS As Long)
m_datTime = m_AdjustTime(m_datTime, RHS, Minute(m_datTime))

m_DrawHand m_datTime

End Property

Public Property Get IsPM() As Boolean
IsPM = Hour(m_datTime) >= 12
End Property

Public Property Let SetMinute(ByVal RHS As Long)

If RHS >= 60 Or RHS < 0 Then RHS = 0 m_datTime = m_AdjustTime(m_datTime, Hour(m_datTime), RHS) m_DrawHand m_datTime End Property Public Property Get GetHour() As Long GetHour = Hour(m_datTime) End Property Private Function m_CalcAngle(OriginX As Single, OriginY As Single, Radius As Single, X As Single, Y As Single) As Single If Y = OriginY Then If X < OriginX Then m_CalcAngle = 180 Else m_CalcAngle = 0 End If ElseIf Y < OriginY Then m_CalcAngle = 4.71238898 - Atn((X - OriginX) / (Y - OriginY)) Else m_CalcAngle = 1.570796327 - Atn((X - OriginX) / (Y - OriginY)) End If End Function Private Sub m_DrawHand(DisplayTime As Date) Dim lngItem As Long Dim sngDegAngle As Single Dim sngRadAngle As Single Dim lngHour As Long Dim lngMinute As Long lngHour = Hour(DisplayTime) lngMinute = Minute(DisplayTime) sngDegAngle = (360 / 12) * lngHour sngDegAngle = sngDegAngle + ((360 / 12 / 60) * lngMinute) sngRadAngle = (sngDegAngle - 90) * (PI / 180) For lngItem = 1 To m_Wrna1.Count With m_Wrna1.Item(lngItem) .Left = m_iparengan + (m_GudangOrg + (Cos(sngRadAngle) * m_Lengkok1(lngItem))) - (m_Wrna1.Item(lngItem).Width / 2) .Top = m_ExcelVba + (m_KasirOrg + (Sin(sngRadAngle) * m_Lengkok1(lngItem))) - (m_Wrna1.Item(lngItem).Height / 2) End With Next sngDegAngle = (360 / 60) * lngMinute sngRadAngle = (sngDegAngle - 90) * (PI / 180) For lngItem = 1 To m_Wrna2.Count With m_Wrna2.Item(lngItem) .Left = m_iparengan + (m_GudangOrg + (Cos(sngRadAngle) * m_Lengkok2(lngItem))) - (m_Wrna2.Item(lngItem).Width / 2) .Top = m_ExcelVba + (m_KasirOrg + (Sin(sngRadAngle) * m_Lengkok2(lngItem))) - (m_Wrna2.Item(lngItem).Height / 2) End With Next DoEvents End Sub Public Property Get GetMinute() As Long GetMinute = Minute(m_datTime) End Property Public Property Let OriginX(RHS As Single) m_GudangOrg = RHS End Property Public Property Let OffsetX(RHS As Single) m_iparengan = RHS End Property Public Property Let OffsetY(RHS As Single) m_ExcelVba = RHS End Property Public Property Let OriginY(RHS As Single) m_KasirOrg = RHS End Property Public Property Let Radius(Hand As enumClock, RHS As Single) Dim labTemp As MSForms.Label Dim sngRadius As Single Dim lngItem As Long Dim colTemp As Collection Dim strPrefix As String Dim sngTempRadius() As Single If Hand = enumClockHourHand Then Set colTemp = m_Wrna1 strPrefix = mHOUR_PREFIX Else Set colTemp = m_Wrna2 strPrefix = mMINUTE_PREFIX End If sngRadius = RHS Do While sngRadius > 0
Set labTemp = Parent.Controls.Add("Forms.Label.1", strPrefix & colTemp.Count + 1)
With labTemp
.Caption = "."
.Font.Size = 30
.BackStyle = fmBackStyleTransparent
.TextAlign = fmTextAlignCenter
.AutoSize = True
.ForeColor = vbGreen
End With
lngItem = lngItem + 1
ReDim Preserve sngTempRadius(lngItem) As Single
sngTempRadius(lngItem) = sngRadius
colTemp.Add labTemp, CStr(colTemp.Count + 1)
sngRadius = sngRadius - 2
Loop

If Hand = enumClockHourHand Then
Set colTemp = m_Wrna1
strPrefix = mHOUR_PREFIX
m_Lengkok1 = sngTempRadius
Else
Set colTemp = m_Wrna2
strPrefix = mMINUTE_PREFIX
m_Lengkok2 = sngTempRadius
End If

End Property
Public Property Let SetTime(RHS As Date)

m_datTime = m_AdjustTime(RHS, Hour(RHS), Minute(RHS))

Me.SetHour = Hour(m_datTime)
Me.SetMinute = Minute(m_datTime)

End Property
Public Sub UpdateHand(Hand As enumClock, X As Single, Y As Single, PM As Boolean)

Dim lngItem As Long
Dim sngDegAngle As Single
Dim sngRadAngle As Single
Dim lngPreviousHour As Long
Dim lngPreviousMinute As Long
Dim lngHour As Long
Dim lngMinute As Long

If Y = m_KasirOrg Then
If X < m_GudangOrg Then sngRadAngle = 180 * (PI / 180) Else sngRadAngle = 0 End If ElseIf Y < m_KasirOrg Then sngRadAngle = 4.71238898 - Atn((X - m_GudangOrg) / (Y - m_KasirOrg)) Else sngRadAngle = 1.570796327 - Atn((X - m_GudangOrg) / (Y - m_KasirOrg)) End If sngDegAngle = (sngRadAngle * (180 / PI)) Select Case sngDegAngle Case Is >= 270
sngDegAngle = sngDegAngle - 270
Case Else
sngDegAngle = sngDegAngle + 90
End Select

If Hand = enumClockHourHand Then
lngHour = CLng(sngDegAngle / (360 / 12) - 0.5)
lngMinute = CLng((sngDegAngle - ((360 / 12) * lngHour)) / (360 / 12 / 60))
If PM Then
lngHour = lngHour + 12
End If
Else
lngMinute = CLng(sngDegAngle / (360 / 60))
lngHour = Me.GetHour
End If

Me.SetMinute = lngMinute
Me.SetHour = lngHour

End Sub
Private Sub Class_Initialize()

Set m_Wrna1 = New Collection
Set m_Wrna2 = New Collection

End Sub

Private Sub Class_Terminate()

Do While m_Wrna1.Count > 0
Parent.Controls.Remove mHOUR_PREFIX & m_Wrna1.Count
m_Wrna1.Remove m_Wrna1.Count
Loop
Set m_Wrna1 = Nothing

Do While m_Wrna2.Count > 0
Parent.Controls.Remove mMINUTE_PREFIX & m_Wrna2.Count
m_Wrna2.Remove m_Wrna2.Count
Loop
Set m_Wrna2 = Nothing

End Sub


Hihihihi panjang amat ya kode macronya, saya yakin pasti anda tidak mau membacanya, langsung copy paste tentunya, kalau saya jadi pembaca tidak akan melakukan copy paste dulu, tapi saya akan cari link download sampelnya. Iyalah benar saja saya akan sertakan sampel dari artikel ini, silahkan download

# MenampilkandatatertentukedalamTextBox #ExcelPro #Macro #VBA #MacroExcel #ExcelVba #BelajarExcel #BelajarMacro #BelajarVBA #KelasExcel #RumahExcel
asis10.com, Excel Pro, Macro, VBA, #MacroExcel, ExcelVba, BelajarExcel, BelajarMacro, BelajarVBA, KelasExcel, RumahExcel

Download - Membuat Jam dengan Excel

Demikianlah Membuat Jam dengan Excel, jika anda kesulitan download file sampel silahkan hubungi kami dengan mengisi kolom komentar dibawah, gabung di IG kami atau Like fanpage Excel Pro
No comments