|
n さん ありがとうございます
>>まだ、完全に理解しきれていないのですが
は
>私の提示のSub test()の場合は
>UserForm1.Show vbModal
>の直後に
>Unload UserForm1
>を実行していますから。
を頂いて見通しがよくなったような気がします
>『End ステートメント』のヘルプを読むと使う気が無くなると思ってましたがそうでもないですか?
上記2点は
目で追っていても右から左へだったみたいなで・・ (*o*)\baki
>Show メソッドのヘルプを見てください。
こんな違い気にしたことがありませんでした
どちらも、もっとよく確認するようにしたいと思います
具体的な書き込みありがとうございました
今回は、n さんのコードを利用させて頂きたいと思います
Abyss さんのコードについては、APIをもう少し理解して
次回にチャレンジしてみたいと思います
よろしければ
n さんの
>SetTimer/KillTimerなどを使いこなせるレベルではありませんので
について
注意する点等有りましたら簡単にコメント頂ければと思います
イメージ的には、例えば
OnTimeをセットすると、解除しない限り残っていて
完了するまでそのブックを呼び出し、マクロを実行する
みたいなようなことがあるような気がするのですが・・・
違っているかも知れませんが、何かあればよろしくお願い致します
今回の希望の操作は下記でかないました
n さん、Abyss さん ありがとうございました
今後もよろしくお願い致します
'-------------------------------------------------------------------------
'ThisWorkbook
Option Explicit
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
'-------------------------------------------------------------------------
'UserForm1
Option Explicit
Private Declare Function FindWindow _
Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String _
, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong _
Lib "user32" Alias "GetWindowLongA" _
(ByVal Hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Sub SetWindowLong _
Lib "user32" Alias "SetWindowLongA" _
(ByVal Hwnd As Long, ByVal nIndex As Long _
, ByVal dwNewLong As Long)
'Private Declare Sub DrawMenuBar _
' Lib "user32" (ByVal Hwnd As Long)
Private Const GWL_STYLE As Long = (-16)
Private Const WS_SYSMENU As Long = &H80000
Private Sub CommandButton1_Click()
tm_Continue = 1&
End Sub
Private Sub CommandButton2_Click()
tm_Continue = -1&
End Sub
Private Sub UserForm_Activate()
Call eventChk
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If tm_Continue = 0 Then tm_Continue = -1&
Cancel = CInt(CloseMode = vbFormControlMenu)
End Sub
Private Sub UserForm_Initialize()
Dim myHwnd As Long
Dim myWLng As Long
myHwnd = FindWindow("ThunderDFrame", Me.Caption)
myWLng = GetWindowLong(myHwnd, GWL_STYLE)
myWLng = myWLng And Not WS_SYSMENU
SetWindowLong myHwnd, GWL_STYLE, myWLng
End Sub
'-------------------------------------------------------------------------
'Module1
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public IsTimerOn As Boolean
Public tm_Continue As Long
Public changeTime As Date
Public setTime As Date
Private oLabel As MSForms.Label
Private Const interval = "0:00:05"
'Private Const interval = "0:00:30"
Sub timerStart()
'↓追加
If IsTimerOn Then Application.OnTime setTime, "TimeCheck", , False
changeTime = Now
setTime = Now + TimeValue(interval)
Application.OnTime setTime, "TimeCheck"
'↓追加
IsTimerOn = True
End Sub
Sub TimeCheck()
Dim chkTime As Date
chkTime = changeTime + TimeValue(interval)
If setTime < chkTime Then
setTime = chkTime
Application.OnTime setTime, "TimeCheck"
IsTimerOn = True
Else
IsTimerOn = False
Call test
End If
End Sub
Sub test()
'保険として
On Error Resume Next
Set oLabel = UserForm1.Label3
On Error GoTo 0
If oLabel Is Nothing Then Exit Sub
tm_Continue = 0&
UserForm1.Show vbModal
'UserForm1.Show vbModeless
Unload UserForm1
If tm_Continue > 0& Then
'MsgBox "Continue"
Call timerStart
Else
MsgBox "Close"
End
End If
End Sub
Sub eventChk()
Dim gap As Single
Dim ii As Single
ii = Timer + 30! '30秒タイマ
Do
gap = ii - Timer
oLabel.Caption = Format$(gap, "00 . 00")
DoEvents
If tm_Continue <> 0& Then Exit Do
Call Sleep(1&)
Loop Until gap <= 0!
UserForm1.Hide
'Unload UserForm1
End Sub
|
|