Excel VBA質問箱 IV

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

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


5347 / 13644 ツリー ←次へ | 前へ→

【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

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

Instancingという項目を既定値の「1 − Private」から
「2 − 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


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

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

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

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

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

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

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

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

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

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

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

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

引用なし
パスワード
   運用方法

・    Excelを起動してください。

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

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

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

・    Book1のThisworkBookのモジュールに

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

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

‘=======================================================================
'↓  timerjust イベントを提供  3
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 '4回繰り返したら処理終了

End Sub


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

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

プロジェクトreptprocは上記の1,2,3の3つの機能を有します。

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

Class1の機能

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

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


試してみてください。

5347 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free