乱数を発生させ、発生した数に対応するファイルが自動

質問

A1からA6まのでマクロ付きファイルが６個あります。
ファイルXを作り１～６の乱数を発生させて、例えば２が発生したとき、A2ファイルが自動的に起動してマクロを実行させるマクロ付きファイルXを作成することは可能でしょうか？
可能な場合、ファイルXのマクロはどのようになるでしょうか？

流れを書くと以下のようになります。
(1) ファイルXを（手動で）起動
(2) ファイルXのマクロを（手動で）起動
(3) （マクロにより）乱数が発生
(4) 例えば、乱数が“２”である場合、A2ファイルが自動的に起動
(5) A2ファイルのマクロが自動的に起動
(6) （A2ファイルのマクロが実行）
(7) （A2ファイルのマクロが終了）

・Excel2013を使っています。
・A1からA6まのでマクロ付きファイルは既に作成済です。
　但し、そのファイルは起動しても自動的にマクロを実行せず、手動で起動できる状態です。

回答No.3

Prome_Lin · ベストアンサー

そちらの環境に合わせてください。

Option Explicit
Sub Test()
Dim r As Integer
Dim s As String
r = Int(Rnd * 6) + 1
s = CStr(r)
Workbooks.Open "D:\Programming\A" & s & ".xlsm" '←フォルダの位置関係
Application.Run "A" & s & ".xlsm!Test" '←「Test」を開いたファイルのマクロの名前
End Sub

現在、「A～.xlsm」ファイルを開いたときのマクロの名前は同一、という前提で組んでいます。

また、フォルダ名を直接指定していますが、もし、いろんなフォルダで実行する可能性がある場合は、元のファイルと「A～.xlsm」ファイルが同じフォルダなら、方法はあります。

Set o = CreateObject("Scripting.FileSystemObject")
のあと、
Set f = o.GetFolder(".")
とすれば、「f」に現在のフォルダ位置が取り込まれますので、「f & "\A～.xlsm」で開くことができます。

補足

ご回答有難う御座います。
試したのですが、なぜか、A５だけ　マクロが実行されます。

回答No.4

Prome_Lin

回答No.3です。

まず、「A1～5」のファイルは、開きますか？

次に、「A1～5」のマクロの「Sub ～」の名前は、具体的にどうなっていますか？

私が試したときは、すべて「Sub Test()」で試しましたので、プログラム中でも、直接「Test」と固定していますが、もしかして、ファイルごとに、名前が違うのでしたら、それを教えてください。

書き直します。

お礼

ご回答有難う御座いました。
何回もやると、やはり教えて頂きましたやり方で、上手く処理できました。

補足

ご回答有難う御座います。
下記で実行しますと、正常に乱数が発生しました。
なぜか、コードを途中で止めると、同じ数（例えば５）が繰り返されます。
rとsを強制的に初期化することはできないでしょうか？

Sub Test()
Dim r As Integer
Dim s As String
r = Int(Rnd * 6) + 1
s = CStr(r)
MsgBox r
End Sub

回答No.2

kkkkkm

開くファイルのThisWorkbookモジュールでWorkbook_Openを使えば起動時に自動でマクロが実行されますがそれを利用しないという事でしたら

プロシージャ名がtestで開くファイルが同一フォルダにあるとした場合

Workbooks.Open ThisWorkbook.Path & "\A2.xlsm"

シートモジュールなら
Call Application.Workbooks("A2.xlsm").Sheets(シート名).test

標準モジュールなら
Application.Run "a2!Test"

でいかがですか。

お礼

ご回答有難う御座いました。

回答No.1

mdmp2

1～6 の乱数を生成するには、つぎの式で良いと思います。
=ROUND((RAND()*5+1),0)

Xファイルを手動で開くとマクロが自動実行され、それによりファイル1～６が開き、開いたファイルのマクロが自動実行されるようにするには、すべてのファイルのマクロの名前を
Auto_Open() とするか、イベントプロシージャ(Workbook_Open) を使います。

ブックを開くコードは、(余計なお世話かもしれませんが）
Workbooks.Open "D:\1.xlsx"

お礼

ご回答有難う御座いました。