Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


20953 / 76732 ←次へ | 前へ→

【61187】Re:一定時間選択変更がなければ上書保存でループにハマル
お礼  ON  - 09/4/15(水) 10:43 -

引用なし
パスワード
   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
1 hits

【61104】一定時間選択変更がなければ上書保存でループにハマル ON 09/4/9(木) 16:28 質問
【61105】Re:一定時間選択変更がなければ上書保存で... ON 09/4/9(木) 16:41 発言
【61106】Re:一定時間選択変更がなければ上書保存で... ON 09/4/9(木) 17:02 発言
【61112】Re:一定時間選択変更がなければ上書保存で... n 09/4/9(木) 22:39 発言
【61115】Re:一定時間選択変更がなければ上書保存で... ON 09/4/10(金) 10:11 お礼
【61123】Re:一定時間選択変更がなければ上書保存で... n 09/4/10(金) 12:12 発言
【61124】Re:一定時間選択変更がなければ上書保存で... Abyss 09/4/10(金) 12:29 発言
【61133】Re:一定時間選択変更がなければ上書保存で... ON 09/4/10(金) 18:22 お礼
【61135】Re:一定時間選択変更がなければ上書保存で... n 09/4/10(金) 20:52 発言
【61136】Re:一定時間選択変更がなければ上書保存で... Abyss 09/4/10(金) 22:07 発言
【61140】Re:一定時間選択変更がなければ上書保存で... Abyss 09/4/10(金) 23:06 発言
【61142】Re:一定時間選択変更がなければ上書保存で... n 09/4/11(土) 2:31 発言
【61176】Re:一定時間選択変更がなければ上書保存で... ON 09/4/14(火) 16:00 質問
【61177】Re:一定時間選択変更がなければ上書保存で... ON 09/4/14(火) 16:32 質問
【61179】Re:一定時間選択変更がなければ上書保存で... n 09/4/14(火) 19:14 発言
【61183】Re:一定時間選択変更がなければ上書保存で... n 09/4/15(水) 0:24 発言
【61187】Re:一定時間選択変更がなければ上書保存で... ON 09/4/15(水) 10:43 お礼
【61188】Re:一定時間選択変更がなければ上書保存で... n 09/4/15(水) 12:44 発言
【61189】Re:一定時間選択変更がなければ上書保存で... ON 09/4/15(水) 13:02 発言
【61190】Re:一定時間選択変更がなければ上書保存で... n 09/4/15(水) 15:00 発言
【61192】Re:一定時間選択変更がなければ上書保存で... neptune 09/4/15(水) 15:35 発言
【61193】Re:一定時間選択変更がなければ上書保存で... ON 09/4/15(水) 17:43 お礼
【61198】Re:一定時間選択変更がなければ上書保存で... Abyss 09/4/15(水) 23:38 発言
【61221】Re:一定時間選択変更がなければ上書保存で... ON 09/4/16(木) 15:59 お礼

20953 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free