| |
根本的な問題は別にして置いて、
ご提示のコードを見た感じ、Userformの扱いに
問題点があると思われます（Object扱い）。
スムーズなコードの動作なら、↓のような
取り入れもいいと思います。
----（標準モジュール）------
Public Declare Function SetTimer Lib "User32" _
(ByVal Hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "User32" _
(ByVal Hwnd As Long, _
ByVal uIDEvent As Long) As Long
Private Declare Function GetTickCount Lib "Kernel32" _
() As Long
Public IsTimerOn As Boolean
Public changeTime As Date
Public setTime As Date
Private Const interval = "0:00:08"
Private UF As UserForm1
Private ii As Long
Private oLabel As MSForms.Label
Public Sub timerStart()
changeTime = Now
setTime = Now + TimeValue(interval)
Application.OnTime setTime, "TimeCheck"
End Sub
Private Sub TimeCheck()
If setTime - TimeValue(interval) < changeTime Then
setTime = changeTime + TimeValue(interval)
Application.OnTime setTime, "TimeCheck"
IsTimerOn = True
Else
IsTimerOn = False
test
End If
End Sub
Private Sub test()
Set UF = New UserForm1
'保険として
On Error Resume Next
Set oLabel = UF.Label1
On Error GoTo 0
If oLabel Is Nothing Then Exit Sub
ii = GetTickCount() + 30& * 1000& '30秒タイマ
UF.Show vbModal
If UF.Continue Then timerStart
Unload UF
Set UF = Nothing
End Sub
Public Sub TimerProc(ByVal Hwnd As Long, _
ByVal uMsg As Long, _
ByVal idEvent As Long, _
ByVal dwTime As Long)
If UF Is Nothing Then
KillTimer 0&, idEvent: Exit Sub
End If
Dim gap As Long
gap = ii - dwTime
If gap <= 0& Then
KillTimer 0&, idEvent
UF.Hide
Exit Sub
End If
oLabel.Caption = Format$(gap \ 10&, "00 : 00")
End Sub
----（Userformモジュール）-------
Public Continue As Boolean
Private TimerID As Long
Private Sub CommandButton1_Click() '継続
Continue = True
Hide
End Sub
Private Sub CommandButton2_Click() '終了
Hide
End Sub
Private Sub UserForm_Initialize()
TimerID = SetTimer(0&, 0&, 10&, AddressOf TimerProc)
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If TimerID Then KillTimer 0&, TimerID
Cancel = 1
Hide
End Sub
----（ThisWorkbookモジュール）-----
Private Sub Workbook_SheetSelectionChange _
(ByVal Sh As Object, ByVal Target As Range)
changeTime = Now
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If IsTimerOn Then
Application.OnTime setTime, "TimeCheck", , False
End If
End Sub
|
|
Abyss
- 09/4/10(金) 12:29 -
