Application.OnTime tidak ada bedanya antara xl2007 dengan versi lainnya.
Script aktifkan pesan thread agar prosedur SetTimer dijalankan diwaktu
tertentu :
Public Sub SetTimer()
Dim lState As Long 'var status locked (0 = false alias bisa diubah
isi cellnya, selainnya tidak bisa)
Dim dtNext As Date 'data waktu akan dijalankannya lagi prosedur
settimer ini
dtNext = Now() 'nilai waktu awal
lState = (Hour(dtNext) + 3) Mod 4 'set status
Sheet1.Protect "Belajar-Excel", userinterfaceonly:=True 'proteksi
sheet
Sheet1.Range("i2").Locked = (lState <> 0) 'set properti locked milik
cell i2
'menentukan waktu untuk dijalankannya lagi prosedur settimer
dtNext = Int(Now) + TimeValue(Hour(dtNext) & ":00:00") + TimeValue(2 -
lState Mod 2 & ":00:00")
'proses pesan thread agar pada waktu dtNext, prosedur bernama SetTimer
dijalankan
Application.OnTime dtNext, "SetTimer"
End Sub
Script pembatalan pesanan thread proses di atas :
Public Sub StopTimer()
On Error Resume Next 'trap error
'batalkan pesanan thread
Application.OnTime Now + TimeValue("00:00:01"), "SetTimer",
schedule:=False
'clear error dan set trap error kembali seperti semula
Err.Clear
On Error GoTo 0
End Sub
Jika masih error, coba :
1. hapus dim dtNext as date dari dalam prosedur SetTimer
2. buat deklarasi pada level module dengan scope public untuk variabel
dtNext bertipe date (sebelum prosedur SetTimer = baris kedua dalam lembar
script)
public dtNext as date
3. pada prosedur stoptimer bagian :
Now + TimeValue("00:00:01")
diubah menjadi :
dtnext
Wassalam,
Kid.
On Thu, Nov 22, 2012 at 8:12 PM, ngademin Thohari <[email protected]>wrote:
> **
>
>
> mr. kid
> sudi kah kiranya menjelaskan di bawah ini, saya masih bingung plus awam
>
> Option Explicit
>
> Public Sub SetTimer()
> Dim lState As Long
> Dim dtNext As Date
>
> dtNext = Now()
> lState = (Hour(dtNext) + 3) Mod 4
> Sheet1.Protect "Belajar-Excel", userinterfaceonly:=True
> Sheet1.Range("i2").Locked = (lState <> 0)
> dtNext = Int(Now) + TimeValue(Hour(dtNext) & ":00:00") + TimeValue(2 -
> lState Mod 2 & ":00:00")
> Application.OnTime dtNext, "SetTimer"
> End Sub
>
> Public Sub StopTimer()
> On Error Resume Next
> Application.OnTime Now + TimeValue("00:00:01"), "SetTimer",
> schedule:=False
> Err.Clear
> On Error GoTo 0
> End Sub
>
> terima kasih
>
> amin
>
>
>
