| |
ぴぐぴぐ さん：
パパち さん：
おはようございます。
>Do Wihle 〜 Loop を利用するよりも、ＣＰＵに負荷がすくなくて
すんでいます。
私は、繰り返し処理に関しては、Do〜LoopとOntimeメソッド
ケースバイケースで使い分けるように心がけています。
今回は、何も解説がなかったのでユーザーフォームは、モーダルモードだと
解釈してのループするコードだったんですが、
場合によっては、Ontimeメソッドを使ったほうが動作が安定していつ場合も
ありますねえ！！
ループ中にSleepを入れておくと、CPUの占有率はそれほど高くならないという
結果からの判断で Do〜Loopの例を投稿しました。
モーダルモードのユーザーフォーム内での繰り返し処理では、実験も兼ねて
私は、殆ど Do〜Loopです
（と言っても、そんな滅多にこんな事象はありませんが）
>ontime、一応しらべたんですが、いまいちよくわからなかったので。
では、Ontimeを使った例です。
ユーザーフォーム（Userform1）には、以下のコントロールを
配置してください。
Label1 ----- 日付の表示用
Label2 ----- 時刻表示用
Textbox1 ----- 日付・時刻表示中に入力が可能か確認用
では、コードです。
標準モジュールに 繰り返し処理管理プログラムパック
これは、以前作成したものです。
'======================================
Private exetm As Variant '次の実行時刻
Private lmcnt As Long '繰り返し回数
Private ccnt As Long '現在の実行回数
Private reptm As Variant '実行間隔時間
Private prcnm As String '実行プロシジャー名
'===============================================================
Sub mc_schedule(ByVal on_off As Boolean, _
Optional ByVal limit_cnt As Long = 0, _
Optional ByVal rep_time As Variant, _
Optional ByVal proc_name As String, _
Optional ByVal F_Exetm As Variant)
'マクロ実行のスケジュールの設定を行う
'input : on_off --- true スケジュール設定 false---スケジュール解除
' limit_cnt 実行を繰り返す回数 0の場合は、制限なく繰り返す
' rep_time 実行間隔時間
' proc_name 実行するプロシジャー名
' F_Exetm 初回実行時間 省略すると、現在の時刻+実行間隔時間
On Error Resume Next
If on_off = True Then
reptm = rep_time
If limit_cnt <> -1 Then
lmcnt = limit_cnt
ccnt = 0
End If
If IsMissing(F_Exetm) Then
exetm = Now() + reptm
Else
exetm = F_Exetm
End If
prcnm = proc_name
End If
Application.OnTime EarliestTime:=exetm, Procedure:="mc_exec", Schedule:=on_off
On Error GoTo 0
End Sub
'==================================================================
Sub mc_exec()
'スケジュール設定されたプロシジャーを実行する
Dim wk As Variant
wk = Application.Run(prcnm)
ccnt = ccnt + 1
If lmcnt = 0 Or ccnt < lmcnt Then
Call mc_schedule(True, -1, reptm, prcnm)
End If
End Sub
別の標準モジュールに
'===============================================================
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'=======================================================================
Sub set_time_date()
With UserForm1
.Label1.Caption = Date
.Label2.Caption = Time
End With
DoEvents
Sleep 100
End Sub
'================================================================
Sub repeat_proc()
Call mc_schedule(True, -1, TimeValue("00:00:01"), "set_time_date")
End Sub
'======================================================================
Sub main()
UserForm1.Show
End Sub
最後にUserform1のモジュール
'======================================================================
Sub UserForm_Activate()
repeat_proc
End Sub
'======================================================================
Private Sub UserForm_Terminate()
Call mc_schedule(False)
End Sub
これでmainを実行してみてください
>パパちさんすみません、わざわざ提案していただいて。
>レスポンスが悪くなれば、パパちさんのを採用してみます。
|
|
ichinose
- 08/10/8(水) 8:26 -
