Excel VBA質問箱 IV

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

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


3601 / 13644 ツリー ←次へ | 前へ→

【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 お礼[未読]

【61104】一定時間選択変更がなければ上書保存でル...
質問  ON  - 09/4/9(木) 16:28 -

引用なし
パスワード
   よろしくお願いいたします


一定時間入力がなければブックを上書き保存で終了したいと思っています

動作的には
変更がなければ、警告フォームを出して
そのまま放置であれば30秒したら上書き保存でブックを閉じる

ボタン1 継続編集であれば、再度一定時間でフォームを出し判断
ボタン2 完了であれば、上書き保存でブックを閉じる

のような流れです

起動は、Workbook_OpenでTimerStartを実行で動いていますが

不具合の場所は
ボタン1 継続編集であれば、再度一定時間でフォームを出し判断
で、
フラグ Public tm_continue As Boolean がたっていたら

ユーザーフォームを閉じるとき
再度 'TimerStart すると
マクロ作動中みたいな状況で
ESCキーを押すと
DoEvents '←ここでとまる
となって、シート入力がギコチナイ状況となっています

編集継続のためのTimerStartをどのように呼べばいいでしょうか


---------------------------------------------------------
ThisWorkbook

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  TimerReset
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  TimerReset
End Sub

Private Sub TimerReset()
If TimerSW Then
  TimerStop
  TimerStart
End If
End Sub

---------------------------------------------------------
Module1

Option Explicit

Private SetTime As Date
Public TimerSW As Boolean
Public tm_continue As Boolean

Public Sub TimerStart()
  SetTime = Now + TimeValue("00:00:10")
  Application.OnTime EarliestTime:=SetTime, Procedure:="show_fm"
  TimerSW = True
End Sub

Public Sub TimerStop()

  On Error Resume Next
  Application.OnTime EarliestTime:=SetTime, Procedure:="show_fm", Schedule:=False
  TimerSW = False
  
End Sub

Sub show_fm()

  TimerStart
  UserForm1.Show
  
End Sub

---------------------------------------------------------

UserForm1

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub CommandButton1_Click() '継続

  TimerStop
  Unload Me
  tm_continue = True
  
End Sub

Private Sub CommandButton2_Click() '終了

  TimerStop
  Unload Me
  tm_continue = False

End Sub

Private Sub UserForm_Activate()
  
  Dim i As Integer
  '閉じるまで30秒カウントダウン
  For i = 30 To 0 Step -1
    Me.Label3 = i
    DoEvents
    If TimerSW = False Then Exit For
    Sleep 1000
    DoEvents '←ここでとまる
  Next i

End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

  If tm_continue = True Then
  
    'TimerStart '←これのため、マクロ実行中となるようなです
  
  End If
  
End Sub

---------------------------------------------------------

【61105】Re:一定時間選択変更がなければ上書保存...
発言  ON  - 09/4/9(木) 16:41 -

引用なし
パスワード
   追記です

>起動は、Workbook_OpenでTimerStartを実行で動いていますが
は、まだ組み込んでいません

実行は
マクロの実行/リスト/TimerStart
で、実行しています

わかりにくいと思いますがアドバイスよろしくお願い致します

【61106】Re:一定時間選択変更がなければ上書保存...
発言  ON  - 09/4/9(木) 17:02 -

引用なし
パスワード
   追記です
UserForm_QueryClose
を、下記に変更してみましたが
やはりマクロが実行中のままとなります

Private Sub UserForm_Terminate()

  If tm_continue = True Then  
    Call TimerStart  '←これのため、マクロ実行中となる  
  End If
  
End Sub

【61112】Re:一定時間選択変更がなければ上書保存...
発言  n  - 09/4/9(木) 22:39 -

引用なし
パスワード
   SelectionChangeの度にTimerStop/TimerStartを繰り返すのは非効率のような気がします。
SelectionChangeで変更時間のみを記録して、OnTime実行時にチェック&再セットしてはいかがでしょう。
以下、一例です。

'-------------------------------------------------
'標準モジュール
Option Explicit

Public changeTime As Date
Public setTime  As Date
Public Const interval = "0:00:10"

Sub timerStart()
  changeTime = Now
  setTime = Now + TimeValue(interval)
  Application.OnTime setTime, "TimeCheck"
End Sub

Sub TimeCheck()
  If setTime - TimeValue(interval) < changeTime Then
    setTime = changeTime + TimeValue(interval)
    Application.OnTime setTime, "TimeCheck"
  Else
    Call test
  End If
End Sub

Sub test()
  UserForm1.Show
End Sub
'-------------------------------------------------
'UserForm1
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private tm_continue As Boolean

Private Sub CommandButton1_Click()
  tm_continue = True
End Sub

Private Sub UserForm_Activate()
  Dim i As Integer

  Me.Repaint
  For i = 10 To 0 Step -1
    Me.Label1 = i
    DoEvents
    If tm_continue Then Exit For
    Sleep 1000
  Next i
  Unload Me
  If tm_continue Then
    setTime = Now + TimeValue(interval)
    Application.OnTime setTime, "TimeCheck"
  Else
    MsgBox "close" 'Close処理
  End If
End Sub
'-------------------------------------------------
'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)
  Application.OnTime setTime, "TimeCheck", , False
End Sub

#常に上書き保存する運用で良いかどうかは別として。

【61115】Re:一定時間選択変更がなければ上書保存...
お礼  ON  - 09/4/10(金) 10:11 -

引用なし
パスワード
   n さんこんにちは ありがとうございます

>SelectionChangeで変更時間のみを記録して、OnTime実行時にチェック&再セットしてはいかがでしょう。

コードのご提示ありがとうございます 
なるほどです、勉強させていただきます
ありがとうございました

>#常に上書き保存する運用で良いかどうかは別として。
了解です
今回はとりあえずで、みたいなです。


>>編集継続のためのTimerStartをどのように呼べばいいでしょうか
についてなんですが

ご提示のコードでも同じ状況になってしまいました

Private Sub UserForm_Activate()
  Dim i As Integer
の i を、外出しで希望に操作がかないました

ユーザーフォームを閉じてしまえば
  For i = 30 To 0 Step -1
も、閉じているような気がしていたのですが違っていたようです
ムム〜 自分的に新発見みたいな・・(~_~;)


何か有りましたらコメントよろしくお願い致します


'-------------------------------------------------
'標準モジュール
Option Explicit

Public changeTime As Date
Public setTime  As Date
Public Const interval = "0:00:30"

Sub timerStart()
  changeTime = Now
  setTime = Now + TimeValue(interval)
  Application.OnTime setTime, "TimeCheck"
End Sub

Sub TimeCheck()
  If setTime - TimeValue(interval) < changeTime Then
    setTime = changeTime + TimeValue(interval)
    Application.OnTime setTime, "TimeCheck"
  Else
    Call test
  End If
End Sub

Sub test()
  UserForm1.Show
End Sub

'-------------------------------------------------
'UserForm1
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private tm_continue As Boolean

Dim i As Integer

Private Sub CommandButton1_Click()
  tm_continue = True
End Sub

Private Sub CommandButton2_Click()
  
  i = 0
  Unload Me
  MsgBox "close" 'Close処理

End Sub

Private Sub UserForm_Activate()
  'Dim i As Integer

  Me.Repaint
  For i = 30 To 0 Step -1
    Me.Label1 = i
    'Me.Label3 = i
    DoEvents
    If tm_continue Then Exit For
    Sleep 1000
  Next i  '←ここで止まった
  Unload Me
  If tm_continue Then
    setTime = Now + TimeValue(interval)
    Application.OnTime setTime, "TimeCheck"
  Else
  
    'On Error Resume Next
    'If UserForm1.Visible = True Then
      MsgBox "close" 'Close処理
    'Else
    'End If
    'On Error GoTo 0
    
  End If
  
End Sub

'-------------------------------------------------
'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)
  Application.OnTime setTime, "TimeCheck", , False
End Sub

【61123】Re:一定時間選択変更がなければ上書保存...
発言  n  - 09/4/10(金) 12:12 -

引用なし
パスワード
   >ご提示のコードでも同じ状況になってしまいました
提示コードに Private Sub CommandButton2_Click() を加えた場合ですね?
その時、Activateイベントが終ってないのでしょうね。
>i を、外出しで希望に操作がかないました
のであればそれで構わないと思います。
または、こんな対応でも。
'-------------------------------------------------
'UserForm1
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private tm_continue As Long '●

Private Sub CommandButton1_Click()
  tm_continue = 1
End Sub

Private Sub CommandButton2_Click()
  tm_continue = -1
End Sub

Private Sub UserForm_Activate()
 Dim i As Integer

 Me.Repaint
 For i = 30 To 0 Step -1
  Me.Label1.Caption = i
  DoEvents
  If tm_continue <> 0 Then Exit For
  Sleep 1000
 Next
 Unload Me
 If tm_continue > 0 Then
  setTime = Now + TimeValue(interval)
  Application.OnTime setTime, "TimeCheck"
 Else
  MsgBox "close" 'Close処理
 End If
End Sub

#また、ThisWorkbookのWorkbook_BeforeCloseで
On Error Resume Next '抜けてました m(_ _)m
Application.OnTime setTime, "TimeCheck", , False

【61124】Re:一定時間選択変更がなければ上書保存...
発言  Abyss  - 09/4/10(金) 12:29 -

引用なし
パスワード
   根本的な問題は別にして置いて、
ご提示のコードを見た感じ、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

【61133】Re:一定時間選択変更がなければ上書保存...
お礼  ON  - 09/4/10(金) 18:22 -

引用なし
パスワード
   n さん ありがとうございます

>提示コードに Private Sub CommandButton2_Click() を加えた場合ですね?
です
>その時、Activateイベントが終ってないのでしょうね。
フォームが閉じたら終わるものと思っていました
よくわからないのですが、この辺強制停止みたいなことは出来るのでしょうか
簡単にコメント頂けるとうれしいです
よろしくお願い致します


>>i を、外出しで希望に操作がかないました
>のであればそれで構わないと思います。
は、もう少し試してみたのですが
どうも、動作がおかしいです
不具合を追いかけることがうまく出来ずに原因はつかめませんでした

>または、こんな対応でも。
では、うまく動作しました

 Unload Me
 If tm_continue > 0 Then
  setTime = Now + TimeValue(interval)
  Application.OnTime setTime, "TimeCheck"
 Else
  MsgBox "close" 'Close処理
 End If

このあたり同様な方法で試してみたような気がしたのですが
なぜかうまく動作させることが出来ずに

>>i を、外出しで希望に操作がかないました
と思ったのですが駄目だったようです。

動作はうまく動いています
もう少し勉強してみます
ありがとうございました


Abyss さん ありがとうございます

>ご提示のコードを見た感じ、Userformの扱いに
>問題点があると思われます(Object扱い)。
>スムーズなコードの動作なら、↓のような
>取り入れもいいと思います。

本格的なコード?のご提示ありがとうございます

自己流で、動けばいいがベースだったので
ステップアップを目指して勉強させて頂きます

まだ、動作確認もしていないので
こんなことをお尋ねするのは心苦しいのですが

>ご提示のコードを見た感じ、Userformの扱いに
>問題点があると思われます(Object扱い)。
で、特にObject扱いが??です

お手数と思いますが
この辺、簡単にコメント頂けると
ご提示のコードの理解がしやすいような気がします
お気が向いたらコメント頂ければうれしいです
よろしくお願い致します

【61135】Re:一定時間選択変更がなければ上書保存...
発言  n  - 09/4/10(金) 20:52 -

引用なし
パスワード
   >強制停止
できなくはないですけど、止めておいたほうが良いです。
知識として知っておくという事なら、『End ステートメント』について調べてみてください。

私が提案したコードについては
>Private tm_continue As Long '●
>
>Private Sub CommandButton1_Click()
>  tm_continue = 1
>End Sub
>
>Private Sub CommandButton2_Click()
>  tm_continue = -1
>End Sub
ここで tm_continue をLong型のフラグとしてます。
Clickイベントではフラグをセットするだけです。
>For i = 30 To 0 Step -1
>  Me.Label1.Caption = i
>  DoEvents
>  If tm_continue <> 0 Then Exit For
>  Sleep 1000
>Next
この監視Loopの中で tm_continue <> 0 で判定して、
継続の場合も終了の場合もLoopを抜けるようにしてます。
強制停止は必要ないでしょう。


ですが、Abyssさんのコードを実行して、是非研究して下さい。
動作もスムーズですし、凄く勉強になります。奥が深いです。

#私も勉強させて頂きます。ありがとうございますm(_ _)m

【61136】Re:一定時間選択変更がなければ上書保存...
発言  Abyss  - 09/4/10(金) 22:07 -

引用なし
パスワード
   今回使われるUserformの目的は
MsgBox的な役割で、Userformから戻り値を
使う方法が適していると思ったのです。

そのため、Userformの扱いはUserform側じゃなく
呼び出す側ですべて管理するのが便利です。

UserformのCloseメッセージをインターセットし、
Hideさせて、実際破棄するのは呼び出す側で処理する。
そうしたら、Userformモジュール中での面倒な処理は
考えなくても済むからです。


Dim UF As Userform1    ' 使われるUserformインターフェースを宣言。
Set UF = New Userform1    ' 実際のUserform1を変数に流し込む。

    ' (諸処理)
    
Unload UF        ' 使い終わったらここでUnload
Set UF = Nothing    ' 変数の開放


私が提示したコードはテスト用として作ったものなので、
整理されていないし、不具合もあるかと思います。とりあえず、一箇所修正です。

>Public Sub timerStart()
>  changeTime = Now
>  setTime = Now + TimeValue(interval)
>  Application.OnTime setTime, "TimeCheck"
>  
>End Sub

     ↓
    
Public Sub timerStart()
  '↓追加
  If IsTimerOn Then Application.OnTime setTime, "TimeCheck", , False
  changeTime = Now
  setTime = Now + TimeValue(interval)
  Application.OnTime setTime, "TimeCheck"
  '↓追加
  IsTimerOn = True
 
End Sub

【61140】Re:一定時間選択変更がなければ上書保存...
発言  Abyss  - 09/4/10(金) 23:06 -

引用なし
パスワード
   nさん、こんばんわ。
こちらこそ、基本の骨格コードはnさんのを
流用させていただきました。
どうも、ありがとうございます。

【61142】Re:一定時間選択変更がなければ上書保存...
発言  n  - 09/4/11(土) 2:31 -

引用なし
パスワード
   こんばんわ、Abyssさん。
そ、そんな...
...拙いコードでたいへん恐縮です^ ^;
最近mougだけではなくこちらでも頻繁にAbyssさんのハイレベルな回答が読めて
たいへん嬉しく感じています。
>今回使われるUserformの目的は
>MsgBox的な役割で、Userformから戻り値を
>使う方法が適していると思ったのです。
という本質的なアドバイスや、レベルが高いコードを惜しげもなく披露してくださっているので
凄く勉強になります。ありがとうございます。

ONさんへ
私もまだSetTimer/KillTimerなどを使いこなせるレベルではありませんので
レベルを落として段階を踏むとしたら...
と考えてみました。
ほとんどAbyssさんのコードの模倣にしか過ぎませんが、
ONさんの理解の一助になれば幸いです。

'-------------------------------------------------
'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 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

'-------------------------------------------------
'標準モジュール
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"

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.Label1
  On Error GoTo 0
  If oLabel Is Nothing Then Exit Sub
  
  tm_Continue = 0&
  UserForm1.Show vbModal
  Unload UserForm1
  If tm_Continue > 0& Then
    'MsgBox "Continue"
    Call timerStart
  Else
    MsgBox "Close"
  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
End Sub

【61176】Re:一定時間選択変更がなければ上書保存...
質問  ON  - 09/4/14(火) 16:00 -

引用なし
パスワード
   遅くなりました

abyss さん コメント頂きありがとうございます

>今回使われるUserformの目的は
>MsgBox的な役割で、Userformから戻り値を
>使う方法が適していると思ったのです。

>そのため、Userformの扱いはUserform側じゃなく
>呼び出す側ですべて管理するのが便利です。

>UserformのCloseメッセージをインターセットし、
>Hideさせて、実際破棄するのは呼び出す側で処理する。
>そうしたら、Userformモジュール中での面倒な処理は
>考えなくても済むからです。

なるほどです
コーディングも楽になるような気がします
が、みてみると難しいです

SetTimer
KillTimer
TimerID = SetTimer(0&, 0&, 10&, AddressOf TimerProc)
TimerProc

とか難しいかったです(理解できていません)


n さん ありがとうございます

>ONさんの理解の一助になれば幸いです。

>レベルを落として段階を踏むとしたら…
ありがとうございます
まだ、完全に理解しきれていないのですが
見比べることが出来て助かりました
元コードだけだと??のままだったようなような気がします

なんとか、双方、なにをしようとしているかは、わかるような気がしますが
API系難のため、少しづつ理解していこうと思います


1点教えて頂きたいのですが
フォームの×ボタンを押すと
abyss さん のは そのまま終了しますが
n さん のは、eventChkが動いています

(最後に×ボタンについては、非表示にしてしまおうと思っているのですが)

eventChk
を止めるには、Endステートメントしかないような気がします

>>強制停止
>できなくはないですけど、止めておいたほうが良いです。
>知識として知っておくという事なら、
>『End ステートメント』について調べてみてください。

VBはよくわかりませんが
VBAでは、Excel自体が終了しないようなのでいいような気がしますが
どうなんでしょう
やはり、不具合はありそうですか

まだテストしていないのですが
End ステートメント
については

UserForm_QueryClose で フラグを立て
eventChk で フラグが立っていたら
End ステートメント
みたいな気もしているのですがどうなんでしょう


アドバイス有りましたらよろしくお願い致します

【61177】Re:一定時間選択変更がなければ上書保存...
質問  ON  - 09/4/14(火) 16:32 -

引用なし
パスワード
   追加のQです

ユーザーフォームについては
vbModeless
とするとどちらも、フォームが表示されなくなってしまうのですが
どうしてそうなるのかわかりません

こちらについてもアドバイスあればよろしくお願い致します

【61179】Re:一定時間選択変更がなければ上書保存...
発言  n  - 09/4/14(火) 19:14 -

引用なし
パスワード
   >eventChk
>を止めるには、Endステートメントしかないような気がします
いやそんな事はないです。
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  tm_continue = 1&
End Sub
など、×ボタンで閉じる事が「継続」なのか「終了」なのか、その意味合いに応じて
tm_continueに値を与えればいいでしょう?
『End ステートメント』のヘルプを読むと使う気が無くなると思ってましたがそうでもないですか?

「すべてのモジュール内のすべてのモジュール レベル変数および静的変数が初期化されます。
...クラス モジュールで作成されたオブジェクトは破壊され、
Open ステートメントを使って開かれたファイルは閉じられ、
プログラムで使われていたメモリは解放されます。
他のプログラムが保持しているオブジェクトへの参照は、無効になります。」

使わないほうが良いと思いますけど。


>ユーザーフォームについては
>vbModeless
>とするとどちらも、フォームが表示されなくなってしまうのですが
>どうしてそうなるのかわかりません

私の提示のSub test()の場合は
UserForm1.Show vbModal
の直後に
Unload UserForm1
を実行していますから。
vbModelessでの実行は想定していません。
Show メソッドのヘルプを見てください。
「ユーザー フォームがモードレスのとき、次のコードは中断されずに継続して実行されます。
...ユーザー フォームがモーダルの場合、アプリケーション内の他の部分を使用する前に、
ユーザーは必ず応答する必要があります。
ユーザー フォームを非表示にするか、またはアンロードするまで、次のコードは実行されません。」

【61183】Re:一定時間選択変更がなければ上書保存...
発言  n  - 09/4/15(水) 0:24 -

引用なし
パスワード
   ぅ。
ごめんなさい。
>Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
>  tm_continue = 1&
>End Sub
これではだめですねorz
×ボタンで閉じる事は「終了」にして

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  If tm_Continue = 0 Then tm_Continue = -1&
End Sub

にしたほうが良いかも。

【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

【61188】Re:一定時間選択変更がなければ上書保存...
発言  n  - 09/4/15(水) 12:44 -

引用なし
パスワード
   >Else
>  MsgBox "Close"
>  End
>End If
あえて使ってるのですよね?


>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_QueryClose(Cancel As Integer, CloseMode As Integer)

  If CloseMode = vbFormControlMenu Then tm_continue = -1&
  Cancel = CInt(CloseMode = vbFormControlMenu)

End Sub
が良かったです、すみません。


>イメージ的には、例えば
>OnTimeをセットすると、解除しない限り残っていて
>完了するまでそのブックを呼び出し、マクロを実行する
>みたいなようなことがあるような気がするのですが・・・
これはその通りなんですが、どこが引っ掛かっているのでしょう?
Workbook_BeforeCloseイベントでの
Application.OnTime setTime, "TimeCheck", , False
解除もれの懸念ですか?

【61189】Re:一定時間選択変更がなければ上書保存...
発言  ON  - 09/4/15(水) 13:02 -

引用なし
パスワード
   n さん ありがとうございます

>あえて使ってるのですよね?
申し訳ありません
テストしたやつが、そのまま残っていました m(_ _)m


>が良かったです、すみません。
ありがとうございます


>これはその通りなんですが、どこが引っ掛かっているのでしょう?
いえいえ 違います

>n さんの
>>SetTimer/KillTimerなどを使いこなせるレベルではありませんので
>について
>注意する点等有りましたら簡単にコメント頂ければと思います
のことです

n さんが、
>使いこなせるレベルではありませんので
とのことで
SetTimer/KillTimer
使用時の、注意点等有りましたら簡単にコメント頂きたい
との思いでした

何か有りましたらよろしくお願い致します

【61190】Re:一定時間選択変更がなければ上書保存...
発言  n  - 09/4/15(水) 15:00 -

引用なし
パスワード
   >SetTimer/KillTimer
>使用時の、注意点等有りましたら簡単にコメント頂きたい
>との思いでした
そちらの方でしたか。
では私もコメントできる知識がないので他の方のレスをお待ちください。
参考サイトとしては、下記などいかがでしょう。
//www.h3.dion.ne.jp/~sakatsu/Excel_Tips15.htm

【61192】Re:一定時間選択変更がなければ上書保存...
発言  neptune  - 09/4/15(水) 15:35 -

引用なし
パスワード
   ▼ON さん:
皆さん、こんにちは。終わった所で失礼します。

>SetTimer/KillTimer
>使用時の、注意点等有りましたら簡単にコメント頂きたい
>との思いでした
>
>何か有りましたらよろしくお願い致します
経験談+私見を。

その昔、ExcelでSetTimerを使っていろんな実験をした事があります。
どんな実験かは忘れましたけど。

で、その挙句、実用にはならないと判断しています。
昔でしたのでPCが低性能だったせいもあるかもしれませんが、
覚えている事を書くと、

・timerprocで何かを処理する度に、画面がチラチラとしたりした事がある。
・最新のExcelは知りませんが、何かの弾みでグローバル、モジュールレベル
の変数がクリアされてしまう事がある。
 →Excelのバグor仕様ですが、これは危険。
・timerproc内で(予期せぬ)エラーが出るとExcelがお亡くなりになる。
 (on error resume nextですべてのエラー処理できるんですかね??)
などが浮かんできます。

後、追加で書くとEnum系は問題出たことないですが、全てのメッセージフック系
は上記のような危険があるので、絶対安全を求めるならやめといた方が
良いです。

以上経験談+私見でした。

ついでに書いとくと、sleepは待機中にはイベントが無視されますので
知って使って下さいね。

【61193】Re:一定時間選択変更がなければ上書保存...
お礼  ON  - 09/4/15(水) 17:43 -

引用なし
パスワード
   n さん ありがとうございます

参考urlありがとうございます
>では私もコメントできる知識がないので他の方のレスをお待ちください。
ムム
n さん が、難しいとおっしゃっているのでは・・・
道のりは、果てしなさそうな・・・・ (‥、)


neptune さん ありがとうございます

>経験談+私見を。
>覚えている事を書くと、
ありがとうございます

ググってみて、類似の書き込みが見つかりました

Subject: CPUの使用率が100%にならないようにするには?
ht tp://www.keep-on.com/excelyou/2001lng4/200106/01060373.txt
上記以外にも、エクセルが落ちる系の書き込みもいくつか見つかりました

ムム ?? 難しそうです

ただ、Abyss さん の、コードでは不具合無く動作しています
どの辺に違いがあるのかよくわかりませんが・・・


先は、見えませんが、兎に角、カメさんを見習ってチビッとづつでも
がんばってみたいと思います


sleep
ありがとうございました。 勉強になります


話が違って申し訳ないのですが
neptune さん に未報告で申し訳なかったのですが

ファイルサーバアクセス権
ht tp://hanatyan.sakura.ne.jp/vb60bbs/wforum.cgi?mode=allread&no=13356&page=0
続 ファイルサーバアクセス権
ht tp://hanatyan.sakura.ne.jp/vb60bbs/wforum.cgi?mode=allread&no=13481&page=0

で大方、解決出来ました ありがとうございました

ただ、最後に、確認したいことがあって、整理中だったのですが
まとまらず、尻切れトンボ状態のままで
心苦しく思いながら、放置状態となってしまっています (T_T)
とりあえず、こちらで懺悔しておきます
と言っても、オショウ さんはこちらにはお見えでないか・・ (*o*)\baki

【61198】Re:一定時間選択変更がなければ上書保存...
発言  Abyss  - 09/4/15(水) 23:38 -

引用なし
パスワード
   >ただ、Abyss さん の、コードでは不具合無く動作しています
>どの辺に違いがあるのかよくわかりませんが・・・

不具合が発生するほどのコードでもないので。
だと言っても、

>・timerprocで何かを処理する度に、画面がチラチラとしたりした事がある。
>・最新のExcelは知りませんが、何かの弾みでグローバル、モジュールレベル
>の変数がクリアされてしまう事がある。
> →Excelのバグor仕様ですが、これは危険。
>・timerproc内で(予期せぬ)エラーが出るとExcelがお亡くなりになる。

は間違いないです。
ちゃんと保険を掛けて、理解の上で使ってください。

【61221】Re:一定時間選択変更がなければ上書保存...
お礼  ON  - 09/4/16(木) 15:59 -

引用なし
パスワード
   Abyss さん ありがとうございます

>不具合が発生するほどのコードでもないので。
>だと言っても、

そうなんですか

neptune さん の 
>昔でしたのでPCが低性能だったせいもあるかもしれませんが、
があったのと
Subject: CPUの使用率が100%にならないようにするには?
も 2001/06/19 のQAだったので
CPUも2-3世代前のような気がしたので
この辺も関係しているのかと思っていました


API少しづつでも理解していきたいとは思っているのですが
実際ほとんど何も理解できていないですが

neptune さん の
>・timerprocで何かを処理する度に、画面がチラチラとしたりした事がある。
>・最新のExcelは知りませんが、何かの弾みでグローバル、モジュールレベル
>の変数がクリアされてしまう事がある。
> →Excelのバグor仕様ですが、これは危険。
>・timerproc内で(予期せぬ)エラーが出るとExcelがお亡くなりになる。
> (on error resume nextですべてのエラー処理できるんですかね??)
>などが浮かんできます。

>後、追加で書くとEnum系は問題出たことないですが、全てのメッセージフック系
>は上記のような危険があるので、絶対安全を求めるならやめといた方が
>良いです。
肝に命じておきたいと思います


皆様
色々ご教授いただきありがとうございました

今後もよろしくお願い致します

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