Sesuai Permintaan dari salah satu best friend, yang ingin mengetahui bagaimana membuat Text berkedip di excel, maka dibuatlah postingan ini.
Seperti diketahui bahwa secara normal text di excel tidak bisa dibuat berkedip, seperti halnya di word, jadi harus diakali dengan kode macro yang mengatur waktu pewarnaan dari teks tersebut dengan menggunakan aplikasi ontime.
Tetapi kalau hanya membuat postingan teks berkedip, tentunya tidak asyik, maka teks berkedip tersebut saya aplikasikan untuk membuat alarm diexcel.
Dimana alarm tersebut akan menghasilkan teks yang berkedip apabila waktunya sesuai dengan setting waktu yang telah ditentukan.
Langsung saja, kode makro dari teks berkedip bisa dilihat di bawah ini:
Kemudian kode untuk melakukan loading kode makro pada workbook bisa dilihat dibawah ini
sebenernya rumus excel diatas bisa juga diganti kode makro... bisa di cari sendiri lah.... buat latihan
Nach... seperti biasa kalau mau lihat contoh hasilnya bisa di DOWNLOAD disini
Seperti diketahui bahwa secara normal text di excel tidak bisa dibuat berkedip, seperti halnya di word, jadi harus diakali dengan kode macro yang mengatur waktu pewarnaan dari teks tersebut dengan menggunakan aplikasi ontime.
Tetapi kalau hanya membuat postingan teks berkedip, tentunya tidak asyik, maka teks berkedip tersebut saya aplikasikan untuk membuat alarm diexcel.
Dimana alarm tersebut akan menghasilkan teks yang berkedip apabila waktunya sesuai dengan setting waktu yang telah ditentukan.
Langsung saja, kode makro dari teks berkedip bisa dilihat di bawah ini:
Public kedip As Double
Sub mulaikedip()
With ThisWorkbook.Sheets(1).Range("E2")
If .Font.ColorIndex = 3 Then
.Font.ColorIndex = 4
.Interior.ColorIndex = 3
Else
.Font.ColorIndex = 3
.Interior.ColorIndex = xlColorIndexNone
End If
End With
kedip = Now + TimeSerial(0, 0, 1)
Application.OnTime kedip, "mulaikedip", True
End Sub
Sub berhentikedip()
With ThisWorkbook.Sheets(1).Range("e2")
.Font.ColorIndex = xlColorIndexAutomatic
.Interior.ColorIndex = xlColorIndexNone
End With
Application.OnTime kedip, "mulaikedip", False
Application.ScreenUpdating = True
End Sub
Sedangkan untuk kode Jamnya sama seperti pada postingan sebelumnya di Excel Calender Slideshow dan Alarm Analog JamSub mulaikedip()
With ThisWorkbook.Sheets(1).Range("E2")
If .Font.ColorIndex = 3 Then
.Font.ColorIndex = 4
.Interior.ColorIndex = 3
Else
.Font.ColorIndex = 3
.Interior.ColorIndex = xlColorIndexNone
End If
End With
kedip = Now + TimeSerial(0, 0, 1)
Application.OnTime kedip, "mulaikedip", True
End Sub
Sub berhentikedip()
With ThisWorkbook.Sheets(1).Range("e2")
.Font.ColorIndex = xlColorIndexAutomatic
.Interior.ColorIndex = xlColorIndexNone
End With
Application.OnTime kedip, "mulaikedip", False
Application.ScreenUpdating = True
End Sub
Option Explicit
Dim nexttick
Sub jam()
ThisWorkbook.Sheets(1).Calculate
nexttick = Now + TimeValue("00:00:01")
Application.OnTime nexttick, "Jam", , True
End Sub
Sub berhenti()
On Error Resume Next
Application.OnTime nexttick, "Jam", , False
Application.ScreenUpdating = True
End Sub
Dim nexttick
Sub jam()
ThisWorkbook.Sheets(1).Calculate
nexttick = Now + TimeValue("00:00:01")
Application.OnTime nexttick, "Jam", , True
End Sub
Sub berhenti()
On Error Resume Next
Application.OnTime nexttick, "Jam", , False
Application.ScreenUpdating = True
End Sub
Kemudian kode untuk melakukan loading kode makro pada workbook bisa dilihat dibawah ini
Private Sub Workbook_BeforeClose(Cancel As Boolean)
berhenti
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
berhenti
End Sub
Private Sub Workbook_Open()
jam
End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
If Range("F2").Value = 1 Then
mulaikedip
Else
berhentikedip
End If
End Sub
dan terakhir aku juga pake rumus di excel,berhenti
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
berhenti
End Sub
Private Sub Workbook_Open()
jam
End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
If Range("F2").Value = 1 Then
mulaikedip
Else
berhentikedip
End If
End Sub
- Rumus di Cell F2 =IF(EXACT((C2+D2),HOUR(NOW())+MINUTE(NOW()))=TRUE,1,"")
- Rumus di cell E2 =IF(F2=1,"ALARM MENYALA","")
Nach... seperti biasa kalau mau lihat contoh hasilnya bisa di DOWNLOAD disini
9 comments:
Semoga Tuhan memberkati ...
salah link kliatanya,,
Bisa kasih link yang baru pak ?
Soalnya file excel yang lain bisa didownload,,
Tuk bikin awal2 makronya gimana?
terus terang aku ms newbi...
trus kalo mau setting alarm per 3 bulan aja gimana? kan file yg sy donlot alarmnya nurut jam kalo nurut hari bulan dan tahun gimana?
makasih mas (Dewi)
Kalau di atas kan hanya jam saja,,
Terima ksh..
Mohon mf sy buta akan rumus excel..msh taraf free basic belajarnya,,
Kalau di atas kan hanya jam saja,,
Terima ksh..
Mohon mf sy buta akan rumus excel..msh taraf free basic belajarnya,,
Sama nih...TANKS MAU BERBAGI
sms/wa 085648536229/085784446556 atw pin bb saya:54655bb4
solder uap
Posting Komentar