SHOJI's Code
 仕事や趣味で書いた各種言語のプログラミングコード(エクセルVBA,PHP,C/C++/C#,JavaScript等)、その他雑記。
2011.08<<123456789101112131415161718192021222324252627282930>>2011.10
スポンサーサイト
上記の広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書く事で広告が消せます。


VBA(EXCEL)でタイマー処理
私は仕事でエクセルを使いVBAマクロをよくプログラミングするが、一定時間ごとに処理したいときなどがよくある。
処理した後で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ずつ数値が増えていく。31000&はタイマーに対してのIDなので、別に31000&でなくても良い。タイマー用のSubには必ずOn Error Resume Nextを行うこと。でないとエラーが発生したときにEXCELごと終了してしまう。


2010/03/29 指摘によりイベントIDは無効ということで、修正
2010/08/23 SetTimer関数に括弧がなかった誤りを修正


テーマ:EXCEL - ジャンル:コンピュータ
コメント
この記事へのコメント
SetTimer関数にhWndを渡さなかった(NULL)場合、第2引数のnIDEvent(例では31000&)は無視されます。結果的に、KillTimerでタイマーは削除されません。

この例の通りhWndをNULLで渡すのであれば、SetTimer関数の戻り値(=タイマ識別値)を保存しておき、
KillTimerにはこの値を指定しなければならないと思います。

http://msdn.microsoft.com/ja-jp/library/cc411200.aspx
2009/08/05(水) 13:31:44 | URL | tm #99DFA69w[ 編集]
Re:
> tmさん

ご指摘ありがとうございます。
2010/03/29(月) 10:53:31 | URL | SHOJI #-[ 編集]
こんにちは。
大変参考になる記事を拝読させていただいています。

ここで挙げられている例をそのまま利用してみると、確かに動作しました。
しかし、SetTimer, KillTimerをThisWorkbookの中からではなく、標準モジュールの中から呼ぶと動作しないようですが、お心当たりはございますでしょうか?

SetTimerの戻り値は 24308 など、0 ではないのでそれ自体は成功しているようです。
しかし、タイマー呼び出しする関数(例ではTimerProc)の中で Debug.Printしても何も表示されないため、呼び出されていないのではないかと考えています。

同じVisual Basicなのに、標準モジュールとThisWorkbookとで挙動が異なるという仕様は理解に苦しみますが、ともあれ動作せず困っています。

元々やりたいことは、処理の進捗状況を何らかの方法で表示することです。
処理の本体の中に進捗状況の表示用のコードを書けばよいのですが、そうすると少し遅くなることが分かりました。
いずれにせよ、処理本体と進捗状況の表示は別のことなので、別スレッドにできれば簡単なのですが、Visual Basic 6.0でなければならないため、そういった機能が使えずません。
別の記事にあるCreateThreadなども少し試しましたがExcelが異常終了するので使えませんでした。

何らかの方法や、修正方法などについて示唆していただけますと幸いです。
2010/08/10(火) 16:12:26 | URL | 玉越 #-[ 編集]
Re:
> 玉越さん

コメントありがとうございます。
特にThisWorkbookからとか標準モジュールからとかで挙動が変わるということは今までありませんでした。

SetTimerはIDも返して動作しているようですね。それで対象の関数が動作しないとなると・・・
・インターバルが間違えていて、異常に長い(1秒くらいのつもりが1分とかにしていて待ちきれていないとか)
・呼び出し先を間違えている
・呼び出し先が関数(Function)でAddressOfを書いていない(Subならエラーになる)
・どのようなロジックで書かれているかわかりませんが、すぐにKillTimerが呼ばれてしまっている
くらいでしょうか。
2010/08/11(水) 12:00:18 | URL | SHOJI #-[ 編集]
お返事ありがとうございます。

もう一度やってみると、動作しました…
ちょっと長いですが、私がやってみたことを書きます。

(標準モジュール: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を使ってコード量が増えるデメリットが大きいと判断して今回は使うのを見送ろうかなあと思っています。

質問させていただき、ありがとうございました。

(それとは別に、上記の私の疑問にお気づきの点などございましたらご教示いただけますと幸いです(^^;
2010/08/13(金) 10:53:32 | URL | 玉越 #-[ 編集]
Re:
> 玉越さん

コメントありがとうございます。

・AddressOfに変数は使えません。サブルーチンか関数だけだったと思います。

・DoEventsしないと多分実行されないでしょうね。タイマー処理もイベントの一つですから。

・このWindows APIを使ったタイマー処理は、ユーザーがEXCELを使っている裏で一定時間毎に処理させたいようなときに使うのに適していると思っています。今回の玉越さんの例には確かにあまり適さないかもしれません。
2010/08/18(水) 10:54:02 | URL | SHOJI #-[ 編集]
お返事ありがとうございます。
いろいろ制限があるんですね。

.NETなら多少ましなようですが、今回はもっと単純な方法で乗り切ろうと思います。
お付き合いいただきありがとうございました。
2010/08/19(木) 12:33:19 | URL | 玉越 #-[ 編集]
'SetTimer 0&, 31000&, 250&, AddressOf TimerProc
で実行すると動作はしますが、前記してある通りkillできず、
id = SetTimer 0&, 31000&, 250&, ddressOf TimerProc
と書くと構文エラーになってしまいました。

何故でしょうか?
2010/08/19(木) 17:08:29 | URL | NORI #gdZ9h5QY[ 編集]
自己レス
id = (SetTimer 0&, 31000&, 250&, ddressOf TimerProc)
でOKでした。
2010/08/20(金) 08:08:15 | URL | NORI #-[ 編集]
Re:
> NORIさん

すいません。記述の誤りでした。
2010/08/23(月) 11:54:54 | URL | SHOJI #-[ 編集]
いきなりですが質問させてください。
いきなりで申し訳ないですが、質問させてください。
id = SetTimer(0&, 31000&, 250&, AddressOf TimerProc)
この”&”を消しても動作しているように見えるのですが、この&は、何ですか?
P.S.難しいことをするときに何度かこの部屋で助かっています。ありがとうございます。
2010/10/21(木) 20:01:56 | URL | Yogi #-[ 編集]
Re: いきなりですが質問させてください。
> Yogiさん

"&"はLong型であることを示します。ちなみに "%"ならInteger, "!"ならSingle, "#"ならDoubleです。
SetTimerに渡す定数が Long であることを明示するためにつけています。確かに無くても動くと思います。
2010/10/28(木) 14:20:42 | URL | SHOJI #-[ 編集]
コメントを投稿する

管理者にだけ表示を許可する
トラックバック
この記事のトラックバックURL
この記事へのトラックバック
copyright © 2004-2006 SHOJI, Powered By FC2ブログ all rights reserved.
FC2ブログ