Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

5368 / 13665 ﾂﾘｰ

←次へ　｜　前へ→

▼

【51308】OnTimeメソッドで呼び出すプロシージャへの引数の渡し方 jabjab 07/9/11(火) 13:49

【51312】Re:OnTimeメソッドで呼び出すプロシージャ... Lindy 07/9/11(火) 15:20

【51313】Re:OnTimeメソッドで呼び出すプロシージャ... jabjab 07/9/11(火) 15:42

【51374】Re:OnTimeメソッドで呼び出すプロシージャ... ichinose 07/9/13(木) 19:10

【51375】Re:OnTimeメソッドで呼び出すプロシージャ... ichinose 07/9/13(木) 20:22

【51389】繰り返し処理プロジェクト　設定編 ichinose 07/9/14(金) 10:46

【51390】繰り返し処理プロジェクト　運用編 ichinose 07/9/14(金) 10:47


	【51308】OnTimeメソッドで呼び出すプロシージャへ...

jabjab - 07/9/11(火) 13:49 -


	引用なし

	パスワード

Excel2003のVBAで一定時間間隔で処理を行うプログラムを考えています。

過去の質問箱やMicrosoftのページなどを調べ、OnTimeメソッドを使った
下記のテストプログラム作ったところ、目的とする動作を行うことができ
ました。
------------------------Test1ここから----------------------
Type testType
　　i As Integer
　　B As String
　　dummyFlag1 As Boolean　 'Testでは使用しません
　　dummyFlag2 As Boolean　 'Testでは使用しません
　　dummyFlag3 As Boolean　 'Testでは使用しません
End Type
Dim A As testType

Sub test()
　　With A
　　　　.i = 10
　　　　.B = "ABC"
　　End With
　　TestOnTime
End Sub

Sub TestOnTime()
　 If A.i > 0 Then
　　　　Cells(1, A.i + 2) = A.B & CStr(A.i)
　　　　A.i = A.i - 1
　　　　Application.OnTime Now + TimeValue("00:00:3"), "'TestOnTime'"
　　End If
End Sub
------------------------Test1ここまで----------------------

最終的には変数Aを引数としてTestOnTimeプロシージャに渡したいと考えて
いるため、下記のプログラムに書き換えたのですが、動作しません。
「マクロ"C:\...\test4.xls'!'TestOnTime "A""が見つかりません」
のエラーが出ます。
------------------------Test2ここから----------------------
Type testType
　　i As Integer
　　B As String
　　dummyFlag1 As Boolean　 'Testでは使用しません
　　dummyFlag2 As Boolean　 'Testでは使用しません
　　dummyFlag3 As Boolean　 'Testでは使用しません
End Type

Sub test()
　　Dim A As testType
　　With A
　　　　.i = 10
　　　　.B = "ABC"
　　End With
　　TestOnTime A
End Sub

Sub TestOnTime(A As testType)
　 If A.i > 0 Then
　　　　Cells(1, A.i + 2) = A.B & CStr(A.i)
　　　　A.i = A.i - 1
　　　　Application.OnTime Now + TimeValue("00:00:3"), _
　　　　　 "'TestOnTime " & """A""" & "'"
　　End If
End Sub
------------------------Test2ここまで----------------------

Application.OnTime Now + TimeValue("00:00:3"), _
"'TestOnTime " & "" & A & "'"
や
Application.OnTime Now + TimeValue("00:00:3"), _
"'TestOnTime " & """" & A & """'"
だと、「型が一致しません」のコンパイルエラーが出ます。

Aがint型やDate型などでは下記のテストプログラムで動作しました。
------------------------Test3ここから----------------------
Sub test()
　　Dim A As Date
　　
　　A = Now
　　TestOnTime 10, A
End Sub

Sub TestOnTime(i As Integer, A As Date)
　　If i > 0 Then
　　　　Cells(1, i + 2) = A
　　　　i = i - 1
　　　　Application.OnTime Now + TimeValue("00:00:3"), _
　　　　　　"'TestOnTime" & """" & i & """,""" & A & """'"
　　End If
End Sub
------------------------Test3ここまで----------------------

------------------------Test4ここから----------------------
Sub test()
　　TestOnTime 10
End Sub

Sub TestOnTime(i As Integer)
　　If i > 0 Then
　　　　Cells(1, i + 2) = CStr(i)
　　　　i = i - 1
　　　　Application.OnTime Now + TimeValue("00:00:3"), _
　　　　　　"'TestOnTime " & "" & i & "'"
'　　　　　 "'TestOnTime " & """" & i & """'" ←こちらでも動作
　　End If
End Sub
------------------------Test4ここまで----------------------

Type で作製した型ではOnTimeメソッドの引数にならないのでしょうか？


	【51312】Re:OnTimeメソッドで呼び出すプロシージ...

Lindy - 07/9/11(火) 15:20 -


	引用なし

	パスワード

▼jabjab さん：こんにちは試してみましたけどうまくいきませんね。私はこのような事をする場合、引数で渡さずに変数をPublic宣言して使ってしまいます。ご参考になれば^^ Public A As testType Type testType 　　i As Integer 　　B As String 　　dummyFlag1 As Boolean　 'Testでは使用しません　　dummyFlag2 As Boolean　 'Testでは使用しません　　dummyFlag3 As Boolean　 'Testでは使用しません End Type Sub test() 　 ' Dim C As testType 　　With A 　　　　.i = 10 　　　　.B = "ABC" 　　End With 　　TestOnTime End Sub Sub TestOnTime() 　 If A.i > 0 Then 　　　　Cells(1, A.i + 2) = A.B & CStr(A.i) 　　　　A.i = A.i - 1 　　　　Application.OnTime Now + TimeValue("00:00:3"), "TestOnTime" 　　End If End Sub


	【51313】Re:OnTimeメソッドで呼び出すプロシージ...

jabjab - 07/9/11(火) 15:42 -


	引用なし

	パスワード

▼Lindy さん：
早々のご回答ありがとうございます。

Public宣言する方法はTest1の手法で実現しております。
＃"End Type"の下の行に紛れて宣言しております・・
＃Publicではなく、Dimにしてしまっていましたがご提示いただいた
＃コードと同じかと思います。

ソースの使い回しやメンテナンスを考えると、できればローカル
変数で実現できればなぁ、と目論んでいるわけです。


	【51374】Re:OnTimeメソッドで呼び出すプロシージ...

ichinose - 07/9/13(木) 19:10 -


	引用なし

	パスワード

こんばんは。

>Type で作製した型ではOnTimeメソッドの引数にならないのでしょうか？

変数は無理だと思いますよ！！
特にローカル変数って、スタック領域に作成されるはずですから、
Ontimeメソッドで指定されたプロシジャーを実行するときには、
すでにメモリ上にはないですからね！！

Application.OnTime Now + TimeValue("00:00:3"), _
　　　　　　"'TestOnTime" & """" & i & """,""" & A & """'"
↑これが作動しているのは、あくまでも定数を引数にしているに過ぎません。

一例です。

新規ブックにて確認してください。

標準モジュールに
'===============================================================
Option Explicit
Public Type 足し算
　 a As Long
　 b As Long
　 End Type
'==============================================================
Sub testtest(p As 足し算)
　　MsgBox p.a + p.b
End Sub

上記のtesttestを連続して繰り返し実行させる事を考えます。

Thisworkbookのモジュールに
'======================================
Option Explicit
'=======================================================================
Event timejust(ByVal cnt As Long, cancel As Boolean, t_para As Variant)
'↑　イベント定義
Private t_int As Date 'インターバル
Private t_prm() As Variant 'パラメータ
Private t_pcnt As Long 'パラメータの個数
Private t_cnt As Long '連続処理回数
Sub timer_set(interval As Date, ParamArray para() As Variant)
'タイマーをセットする
'interval 連続処理を行う間隔
'para() データ渡しのためのパラメータ
　　Dim g0 As Long
　　Erase t_prm()
　　t_int = interval
　　t_pcnt = UBound(para()) + 1
　　For g0 = LBound(para()) To UBound(para())
　　　 ReDim Preserve t_prm(g0)
　　　 t_prm(g0) = para(g0)
　　　 Next
　　Application.OnTime Now() + t_int, "thisworkbook.timer_exe"
　　t_cnt = 0
End Sub
'===================================
Sub timer_exe()
'呼び出しプロシジャー
　　Dim cancel As Boolean
　　If t_pcnt = 0 Then
　　　 RaiseEvent timejust(t_cnt + 1, cancel, False)
　　Else
　　　 RaiseEvent timejust(t_cnt + 1, cancel, t_prm())
　　　 End If
　　t_cnt = t_cnt + 1
　　If cancel = False Then
　　　 Application.OnTime Now() + t_int, "thisworkbook.timer_exe"
　　　 End If
End Sub

更にSheet1のモジュールに
'==============================================================
Option Explicit
Dim WithEvents bk As ThisWorkbook
'===============================================================
Sub main()
　　Set bk = ThisWorkbook
　　bk.timer_set TimeValue("00:00:3")
End Sub
'=======================================================================
Private Sub bk_timejust(ByVal cnt As Long, cancel As Boolean, t_para As Variant)
'cnt 処理の繰り返し回数
'cancel trueを指定すると処理終了
't_para データ引渡し変数
このイベント内で呼び出したいプロシジャーにデータを渡します
　　Dim a As 足し算
　　a.a = cnt
　　a.b = cnt
　　Call testtest(a)
　　If cnt >= 3 Then cancel = True '3回処理したら終了
End Sub

コードは長くなりましたが、再利用可能な形にはなりました。

尚、Sheet1のモジュールの代わりにクラスモジュールを使用して
工夫すればよいかもしれませんね。

一例ですから、試してみてください


	【51375】Re:OnTimeメソッドで呼び出すプロシージ...

ichinose - 07/9/13(木) 20:22 -


	引用なし

	パスワード

>更にSheet1のモジュールに
>'==============================================================
>Option Explicit
>Dim WithEvents bk As ThisWorkbook
>'===============================================================
>Sub main()
>　　Set bk = ThisWorkbook
>　　bk.timer_set TimeValue("00:00:3")
>End Sub
>'=======================================================================
>Private Sub bk_timejust(ByVal cnt As Long, cancel As Boolean, t_para As Variant)
>'cnt 処理の繰り返し回数
>'cancel trueを指定すると処理終了
>'t_para データ引渡し変数
>このイベント内で呼び出したいプロシジャーにデータを渡します
>　　Dim a As 足し算
>　　a.a = cnt
>　　a.b = cnt
>　　Call testtest(a)
>　　If cnt >= 3 Then cancel = True '3回処理したら終了
>End Sub

このSheet1のmainを実行させて確認してください。


	【51389】繰り返し処理プロジェクト　設定編

ichinose - 07/9/14(金) 10:46 -


	引用なし

	パスワード

こんにちは。
前回の投稿をもう少し再利用しやすいように改良しました。

題して、繰り返し処理登録プロジェクト（題して言うほどではないなあ！！）

＊＊設定方法

新規ブックにて。

Thisworkbookのモジュールに

‘=========================================================================
Option Explicit
Event timejust(t_int As Date, cancel As Boolean)
Sub timer_exe()
　　Dim cancel As Boolean
　　Dim t_int As Date
　　RaiseEvent timejust(t_int, cancel)
　　If cancel = False Then
　　　 Application.OnTime Now() + t_int, "thisworkbook.timer_exe"
　　　 End If
End Sub

このブックにクラスモジュールを追加してください。

クラス名　　Class1

ＶＢＥのプロジェクトエクスプローラーにてこのClass1を選択した状態で
Ｆ４キーを押してください。Class1のモジュールのプロパティが表示されます。

Instancingという項目を既定値の「1　－　Private」から
「２　－　PublicNotCreatable」に変更してください。

Class1のクラスモジュールに以下のコードです。

‘============================================================================
Option Explicit
Event timerjust(ByVal cnt As Long, cancel As Boolean, t_para As Variant)
Dim WithEvents bk As ThisWorkbook
Private ct_int As Date
Private ct_prm() As Variant
Private ct_pcnt As Long
Private ct_cnt As Long
‘============================================================================
Sub timer_set(interval As Date, ParamArray para() As Variant)
'連続処理を定義する
' input　interval 連続処理の時間的間隔
' 　　　　para() イベントプロシジャーに渡すパラメータデータ
　　Dim g0 As Long
　　Erase ct_prm()
　　ct_int = interval
　　ct_pcnt = UBound(para()) + 1
　　For g0 = LBound(para()) To UBound(para())
　　　 ReDim Preserve ct_prm(g0)
　　　 ct_prm(g0) = para(g0)
　　　 Next
　　Application.OnTime Now() + ct_int, "thisworkbook.timer_exe"
　　ct_cnt = 0
End Sub
‘============================================================================
Private Sub bk_timejust(t_int As Date, cancel As Boolean)
　　t_int = ct_int
　　If ct_pcnt = 0 Then
　　　 RaiseEvent timerjust(ct_cnt + 1, cancel, False)
　　Else
　　　 RaiseEvent timerjust(ct_cnt + 1, cancel, ct_prm())
　　　 End If
　　ct_cnt = ct_cnt + 1
End Sub
‘============================================================================
Private Sub Class_Initialize()
　　Set bk = ThisWorkbook
End Sub
‘============================================================================
Private Sub Class_Terminate()
　　Set bk = Nothing
End Sub

更に標準モジュールに上記のクラスのインスタンスを取得する関数を記述します。
‘===========================================================================
Function get_class() As Class1
　　Set get_class = New Class1
End Function

このプロジェクトに独自のプロジェクト名を付けます。

ＶＢＥのプロジェクトエクスプローラーにて当該プロジェクトを選択した状態で
「ツール」-----「ＶＢＡProjectのプロパティ」とクリックしてください。

「プロジェクトプロパティ」ダイアログが表示されます。

全般タブのプロジェクト名入力欄に「reptproc」（両端の「」は除く）と指定して、ＯＫボタンをクリックしてください。

これでプロジェクト名が独自のものになりました。

Excelに戻って、適当な名前で保存します。
様々な繰り返し処理に使用可能にするのですから、アドインとして保存します。

名前を付けて保存を選択し、ファイルの種類として「Maicrosoft Excelアドイン（*.xla）」を選択し、
ファイル名としてプロジェクト名と同じように　Reptproc.xla　と命名して適当なフォルダに保存してください。

一度、Excelを閉じて再度起動してみてください。

「ツール」----「アドイン」とクリックしてアドインダイアログを表示させます。

有効なアドイン一覧にreptprocがあれば、チェックしてください。
なければ、参照ボタンをクリックしてreptproc.xlaの存在するフォルダから登録してください。

登録後、ＶＢＥにて、reptprocというプロジェクトが存在が確認できればこの「繰り返し処理登録」プロジェクトが使用可能になります。


	【51390】繰り返し処理プロジェクト　運用編

ichinose - 07/9/14(金) 10:47 -


	引用なし

	パスワード

運用方法

・　　　　Ｅｘｃｅｌを起動してください。

・　　　　新規ブック(book1とします)の標準モジュールにある以下のコードを繰り返し処理することを考えます。

‘================================================================
Option Explicit
Public Type 足し算
　 a As Long
　 b As Long
　 End Type
'==============================================================
Sub testtest(p As 足し算)
　　MsgBox p.a + p.b
End Sub

・　　　　まず、参照設定を行います。
　　ＶＢＥのプロジェクトエクスプローラーにて、当該プロジェクトを選択した状態で
「ツール」---「参照設定」とクリックし、参照設定ダイアログを表示させます。
一覧にrepprocがあるはずです。チェックを入れてＯＫボタンをクリックしてください。
これで参照設定がされていれば、reptprocのコードが使えます。

・　　　　Book1のThisworkBookのモジュールに

‘=======================================================================
Option Explicit
Dim WithEvents reptcls As reptproc.Class1

‘=======================================================================
Sub main()
　　Set reptcls = reptproc.get_class '　Class1のインスタンスの取得　　１
　　reptcls.timer_set TimeValue("00:00:03") '-----　繰り返し時間の間隔設定　２
　　'↑３秒毎に繰り返し処理実行を指示
End Sub

‘=======================================================================
'↓　　timerjust イベントを提供　　３
Private Sub reptcls_timerjust(ByVal cnt As Long, cancel As Boolean, t_para As Variant)
'このイベントプロシジャーに繰り返し処理する
' cnt 繰り返し実行回数　初期値は1
'cancel trueに設定すると、繰り返し処理終了
't_para このイベントプロシジャー内にデータを引き渡す配列（まだ使い道を模索中)
　　Dim Plus As 足し算
　　With Plus
　　　 .a = 5
　　　 .b = 6 + cnt
　　　 End With
　　Call testtest(Plus)
　　If cnt >= 4 Then cancel = True '４回繰り返したら処理終了

End Sub

THisworkbookのmainを実行してみてください。

標準モジュールのtesttestを4回繰り返し処理します。

プロジェクトreptprocは上記の１，２，３の3つの機能を有します。

1　get_class　----　クラスClass1のインスタンスを取得する

Class1の機能

２　timer_set メソッド　------処理を繰り返し実行する時間間隔を登録する

３　timerjustイベント-------timer_setメソッド設定した時間間隔毎発生するイベントです。

試してみてください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

5368 / 13665 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free