処理した後でApplication.OnTimeを使えば可能であるのだが、その度に一瞬砂時計になったり、ファイルを閉じてもまた起動したり、と、あまり私は好きではない。
ところが、この前Win32のSetTimer関数を利用してマクロの関数を呼び出すことができることを知り、試しにプログラミングしてみた。
(標準モジュール)
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 nIDEvent As Long) As Long
Public Sub TimerProc()
On Error Resume Next
Sheet1.Range("A1") = Sheet1.Range("A1") + 1
End Sub
(ワークブック)
Dim id as Integer
Private Sub Workbook_Open()
'SetTimer 0&, 31000&, 250&, AddressOf TimerProc
id = SetTimer(0&, 31000&, 250&, AddressOf TimerProc)
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'KillTimer 0&, 31000&
KillTimer 0&, id
End Sub
このように書くと、このワークブックをオープンすると250msec毎にSheet1のA1セルが1ずつ数値が増えていく。
2010/03/29 指摘によりイベントIDは無効ということで、修正
2010/08/23 SetTimer関数に括弧がなかった誤りを修正
Tweet テーマ:EXCEL - ジャンル:コンピュータ |
この例の通りhWndをNULLで渡すのであれば、SetTimer関数の戻り値(=タイマ識別値)を保存しておき、
KillTimerにはこの値を指定しなければならないと思います。
http://msdn.microsoft.com/ja-jp/library/cc411200.aspx
ご指摘ありがとうございます。
大変参考になる記事を拝読させていただいています。
ここで挙げられている例をそのまま利用してみると、確かに動作しました。
しかし、SetTimer, KillTimerをThisWorkbookの中からではなく、標準モジュールの中から呼ぶと動作しないようですが、お心当たりはございますでしょうか?
SetTimerの戻り値は 24308 など、0 ではないのでそれ自体は成功しているようです。
しかし、タイマー呼び出しする関数(例ではTimerProc)の中で Debug.Printしても何も表示されないため、呼び出されていないのではないかと考えています。
同じVisual Basicなのに、標準モジュールとThisWorkbookとで挙動が異なるという仕様は理解に苦しみますが、ともあれ動作せず困っています。
元々やりたいことは、処理の進捗状況を何らかの方法で表示することです。
処理の本体の中に進捗状況の表示用のコードを書けばよいのですが、そうすると少し遅くなることが分かりました。
いずれにせよ、処理本体と進捗状況の表示は別のことなので、別スレッドにできれば簡単なのですが、Visual Basic 6.0でなければならないため、そういった機能が使えずません。
別の記事にあるCreateThreadなども少し試しましたがExcelが異常終了するので使えませんでした。
何らかの方法や、修正方法などについて示唆していただけますと幸いです。
コメントありがとうございます。
特にThisWorkbookからとか標準モジュールからとかで挙動が変わるということは今までありませんでした。
SetTimerはIDも返して動作しているようですね。それで対象の関数が動作しないとなると・・・
・インターバルが間違えていて、異常に長い(1秒くらいのつもりが1分とかにしていて待ちきれていないとか)
・呼び出し先を間違えている
・呼び出し先が関数(Function)でAddressOfを書いていない(Subならエラーになる)
・どのようなロジックで書かれているかわかりませんが、すぐにKillTimerが呼ばれてしまっている
くらいでしょうか。
もう一度やってみると、動作しました…
ちょっと長いですが、私がやってみたことを書きます。
(標準モジュール:ctimer)
Option Explicit
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 nIDEvent As Long) As Long
(標準モジュール:cprogress)
Option Explicit
Private progress_current_length As Long
Private progress_limit As Long
Public Sub progress_initialize(limit As Long)
progress_current_length = 0
progress_limit = limit
End Sub
Public Sub progress_update(current As Long)
Dim length As Long
length = current * 100 / progress_limit
If progress_current_length < length Then
progress_current_length = length
Sheet1.Range("A1").Value = String(length, "|")
End If
DoEvents
End Sub
(標準モジュール:cprogress2)
Option Explicit
Private progress_current_length2 As Long
Private progress_limit2 As Long
Global progress_now As Long ' 課題1
Private progress_timer_id As Long
Public Function progress_initialize2(limit As Long) As Boolean
progress_now = 0
progress_current_length2 = 0
progress_limit2 = limit
progress_timer_id = SetTimer(0, 0, 33, AddressOf progress_update2)
progress_initialize2 = progress_timer_id <> 0
End Function
Public Sub progress_update2()
Dim length As Long
length = progress_now * 100 / progress_limit2
If progress_current_length2 < length Then
progress_current_length2 = length
Sheet1.Range("A1").Value = String(length, "|")
End If
'DoEvents ' 課題2
End Sub
Public Function progress_finalize2() As Boolean
Dim result As Long
result = KillTimer(0, progress_timer_id)
progress_finalize2 = result <> 0
End Function
(標準モジュール:main)
Option Explicit
Public Sub test1(limit As Long)
Dim i As Long
progress_initialize limit
For i = 0 To limit - 1
work 1000
progress_update i
Next i
End Sub
Public Sub test2(limit As Long)
Dim i As Long
progress_initialize2 limit
For i = 0 To limit - 1
work 1000
progress_now = i '課題1
DoEvents ' 課題2
Next i
Call progress_finalize2 ' 課題3
End Sub
Private Sub work(repetition As Long)
Dim i As Long
Dim x As Variant
For i = 0 To repetition - 1
x = Sheet1.Range("A1").Value
Next i
End Sub
Public Sub test()
Dim nStart As Single
nStart = Timer
test1 1000
Debug.Print Timer - nStart
nStart = Timer
test2 1000
Debug.Print Timer - nStart
End Sub
test()を実行すると、二つの方法の処理時間を計ります。
test1()の方は、タイマーを使わずに進捗を表示する方法、
test2()はタイマーを使う方法です。
多少test2()の方が速いようですが、あまり処理時間に変わりはありませんでした。
それより課題の方が目に付きます。
課題1:
進捗状況をタイマ関数に渡す方法がないので、グローバル変数を使いました。
本体の処理(test2)の中で、グローバル変数の値が変わったことを明示しなければなりません。
AddressOfで変数へのポインタを渡すことはできると思いますが、ポインタの中身を参照する方法はないですよね?
それができれば、progress_initialize2の引数として渡すのですが。
しかも、最初に実行したとき、progress_nowという変数はないよ、とtest2を実行するときにエラーになってしまいました。
仕方ないのでprogress_nowの宣言を標準モジュールmainの方に移した後実行し、その後宣言の場所を元に戻すなぜかエラーは出なくなりました。なぜ???
課題2:
DoEventsを本体の処理(test2)の中に書かないと、タイマ関数に制御が渡ってくれないようです。
これでは何のためのタイマなのか…
それに、最初はDoEventsを入れなくてもタイマが呼ばれていましたが、何かの拍子にDoEventsを入れないと呼ばれなくなってしまいました。
先日私が困っていたのはこの点のようです。
課題3:
タイマを作るので、タイマを破棄しなければなりません。
それは仕方ないのですが、課題1、課題2と合わせて行数が多くなってしまい、みにくくなってしまいます。
Visual Basicの挙動が怪しくてよく分からないし、処理速度にほとんど違いが見られないので、Windows APIを使ってコード量が増えるデメリットが大きいと判断して今回は使うのを見送ろうかなあと思っています。
質問させていただき、ありがとうございました。
(それとは別に、上記の私の疑問にお気づきの点などございましたらご教示いただけますと幸いです(^^;
コメントありがとうございます。
・AddressOfに変数は使えません。サブルーチンか関数だけだったと思います。
・DoEventsしないと多分実行されないでしょうね。タイマー処理もイベントの一つですから。
・このWindows APIを使ったタイマー処理は、ユーザーがEXCELを使っている裏で一定時間毎に処理させたいようなときに使うのに適していると思っています。今回の玉越さんの例には確かにあまり適さないかもしれません。
いろいろ制限があるんですね。
.NETなら多少ましなようですが、今回はもっと単純な方法で乗り切ろうと思います。
お付き合いいただきありがとうございました。
で実行すると動作はしますが、前記してある通りkillできず、
id = SetTimer 0&, 31000&, 250&, ddressOf TimerProc
と書くと構文エラーになってしまいました。
何故でしょうか?
でOKでした。
すいません。記述の誤りでした。
id = SetTimer(0&, 31000&, 250&, AddressOf TimerProc)
この”&”を消しても動作しているように見えるのですが、この&は、何ですか?
P.S.難しいことをするときに何度かこの部屋で助かっています。ありがとうございます。
"&"はLong型であることを示します。ちなみに "%"ならInteger, "!"ならSingle, "#"ならDoubleです。
SetTimerに渡す定数が Long であることを明示するためにつけています。確かに無くても動くと思います。