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

4年くらい前の記事EXCEL VBAによるスレッドのことを書いたが、最近またちょっといじってみたので備忘録的に書いておく。(ちなみに使ったEXCELは2003)

・制限などはあるが、とりあえずスレッドで動くっぽい。

スレッド内では、基本的にはセルに書き込むなどの処理は行えない、っぽい(^^;
 デバッグ出力や、変数の代入などはよさそう。

・Sleep関数は、スレッド内では動作するが、メインのマクロではうまく動かない、っぽい(^^;
 メインのマクロでは、以下のように DoEvents を使ってウェイトする。
Sub SleepVBA(ByVal msec As Long)
On Error Resume Next
Dim c As Double
c = msec / 1000#
t = Timer: While Timer - t < c: DoEvents: Wend
End Sub



・WaitForSingleObjectもうまく動かない、というか、コールしてもスレッドが走らない(ように見える(^^;)。
 次のような感じで使うと、まぁ、動くような感じ。結局メインのマクロでは待ち関連は DoEvents を使わないといけないみたい。
Function WaitForSingleObjectVBA(ByVal h As Long, ByVal msec As Long) As Long
On Error Resume Next
Dim c As Double
t = Timer
While msec = INFINITE Or Timer - t < msec / 1000#
r = WaitForSingleObject(h, 1)
If r <> WAIT_TIMEOUT Then GoTo RetWaitForSingleObjectVBA
DoEvents
Wend
RetWaitForSingleObjectVBA:
WaitForSingleObjectVBA = r
End Function

とりあえず、サンプル的に作ってみたマクロが以下。
Declare Sub Sleep Lib "kernel32" (ByVal msec As Long)
Declare Function CreateThread Lib "kernel32" (ByVal sa As Any, ByVal ss As Long, ByVal addr As Any, ByVal param As Any, ByVal opt As Long, ByRef id As Long) As Long
Declare Function WaitForSingleObject Lib "kernel32" (ByVal h As Long, ByVal tmo As Long) As Long
Declare Sub CloseHandle Lib "kernel32" (ByVal h As Long)
Declare Sub TerminateThread Lib "kernel32" (ByVal h As Long, ByVal code As Long)

Const WAIT_OBJECT_0 = 0
Const WAIT_TIMEOUT = &H102
Const INFINITE = &HFFFFFFFF

Dim running As Boolean
Dim primes(1000) As Long
Dim n_primes As Long

Sub FindPrimes()
candidate = 2
n_primes = 0
While True
f = True
For i = 0 To n_primes - 1
If candidate Mod primes(i) = 0 Then f = False: Exit For
Next i
If f Then
primes(n_primes) = candidate
n_primes = n_primes + 1
If n_primes = 1000 Then GoTo QuitFindPrimes
End If
candidate = candidate + 1
Sleep 10
Wend
QuitFindPrimes:
End Sub

Sub ShowPrimes()
For i = 0 To n_primes - 1
Sheet1.Range("A1").Offset(i, 0).Value = primes(i)
Next i

If running Then Application.OnTime Now + TimeValue("00:00:01"), "ShowPrimes"
End Sub




Sub Start()
On Error Resume Next
Dim h As Long
Dim id As Long

Sheet1.UsedRange.Formula = ""

h = CreateThread(0&, 8192&, AddressOf FindPrimes, 0&, 0&, id)

Application.OnTime Now + TimeValue("00:00:01"), "ShowPrimes"

running = True
WaitForSingleObjectVBA h, INFINITE
running = False

TerminateThread h, 0
CloseHandle h
End Sub

Sub SleepVBA(ByVal msec As Long)
On Error Resume Next
Dim c As Double
c = msec / 1000#
t = Timer: While Timer - t < c: DoEvents: Wend
End Sub

Function WaitForSingleObjectVBA(ByVal h As Long, ByVal msec As Long) As Long
On Error Resume Next
Dim c As Double
t = Timer
While msec = INFINITE Or Timer - t < msec / 1000#
r = WaitForSingleObject(h, 1)
If r <> WAIT_TIMEOUT Then GoTo RetWaitForSingleObjectVBA
DoEvents
Wend
RetWaitForSingleObjectVBA:
WaitForSingleObjectVBA = r
End Function


テーマ:エクセル - ジャンル:コンピュータ
コメント
この記事へのコメント
コメントを投稿する

管理者にだけ表示を許可する
トラックバック
この記事のトラックバックURL
この記事へのトラックバック
copyright © 2004-2006 SHOJI, Powered By FC2ブログ all rights reserved.
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。