VBAでユーザーに別ファイルのシートを選ばせたい場合

質問

エクセル２０００です。
マクロを記載したBOOKを開いたままで、ユーザーに作業の対象とするファイルを開かせ、その中の対象とするファイルを選ばせたら次のマクロに移りたいのですが、以下のマクロですと開いたらすぐ実行されてしまいます。
開いてからユーザーがシートをアクティブにするまで実行を止めるにはどうしたらよいのでしょうか？
BOOKを開かせて一旦マクロを終了し、マクロを記載したBOOKでまた別のボタンを押させるというのなら思いつくのですが・・・。

Sub test01()

MsgBox "対象のエクセルファイルを開いてください。" _
& vbCr & "開いたら該当のシートをアクティブにして下さい。", , " "
If Application.Dialogs(xlDialogOpen).Show = False Then
MsgBox "キャンセルされました。", , "（￣ロ￣；）！！"
Exit Sub
End If

Call 次のマクロ

End Sub

回答No.4

masa_019 · ベストアンサー

こんにちは。

前回、お役に立てなかったので・・・。
元のブックに戻らなくても良いように、コマンドバーのボタンを利用してはどうでしょう？
シートやブックを切り替えても、常に画面上に表示しておけますし、表示場所も自由に制御できます。

merlionXXさんのコードに、ちょっと付け加えさせてもらいますが、

Sub 開始()

Dim MyBar As CommandBar　　　　　　'追加
Dim MyBtn As CommandBarButton　　　'追加

MsgBox "対象のファイルを開いてください。" _
& vbCr & "開いたら該当のシートを選択してください。" _
& vbCr & "" _
& vbCr & "再度このファイルに戻り「決定ボタン」を押して下さい。", , " 対象確認"
If Application.Dialogs(xlDialogOpen).Show = False Then
MsgBox "キャンセルされました。", , "（￣ロ￣；）！！"
ThisWorkbook.Sheets("Sheet1").Range("A1").ID = ""
Exit Sub
Else
ThisWorkbook.Sheets("Sheet1").Range("A1").ID = ActiveWorkbook.Name

'********************************　ここから
On Error Resume Next　　　　
Application.CommandBars("MyBar").Delete
On Error GoTo 0

Set MyBar = Application.CommandBars.Add("MyBar", msoBarFloating, False, True)

With MyBar
Set MyBtn = .Controls.Add(msoControlButton, , , , True)

With MyBtn
.Style = msoButtonCaption
.Caption = "決定"
.OnAction = "決定"
End With

.Visible = True
End With

Set MyBtn = Nothing
Set MyBar = Nothing　　　　
'********************************　ここまで
End If
End Sub

シート上に現れる"決定ボタン"をクリックすることで、Sub 決定()を走らせることができます。
サンプルでは、浮動状態のツールバーを作り、ボタンを配置しておりますが、状況に合わせて右クリックメニューに追加するなどの応用ができます。

お礼

masa_019さま、先日は有難うございました。
コマンドバーのボタンって初めて見ました！
こういうことが出来るんですね、驚きです。
さっそくやってみましたところ、期待通りの働きです。
有難うございます。

甘えついでにご教示いただければ幸いなのですが、このボタンを押し、「決定」マクロが作動したら、×を押さなくともボタンが自動的に消えるようにするにはどうしたらよいのでしょうか？

補足

いろいろやってみましたが、消し方は、

Sub 決定()
MsgBox ActiveSheet.Name
Application.CommandBars("MyBar").Delete
End Sub

でいいのですね？

回答No.9

myRange

こんにちは、エキスパートさん。

＞Userformを使う場合、ひらいたBOOKではないことがわかり
＞キャンセルする場合はどのようにしたらよいのでしょうか？
＞右上の×をクリックしても、「次のマクロ」が実行されてしまうようです。

そこら辺りのことを前回答では
「流れだけ分かればいいということで少し手を抜いてます」
という文言で表現しておりまする。(^^;;;

今回のマクロは他人にも使用させるわけですから、少なくとも
（１）お礼のコメントにもあったように、ブック選択のミス
（２）該当シートを決定する前に、開いたブックを閉じてしまった
（３）該当シートの決定ミス
などの対処を考慮に入れるべきだと考えます。

（UserForm使用の場合）
（１）は仰るように、ブック再選択用にCommandButton2を配置
（２）は、開いたブックは手動では閉じれないようにする
　　　（これにはコードは不要）
（３）は、決定ボタンをクリックしたら、再度確認メッセージを出す

こんなところでしょうか。
ただ（２）を除いては、ユーザーに無視されてしまえば防ぎようがありませんが。。

で、上記を考慮にいれたコード

'--------- 標準モジュール -----------------------

　　Public Flag As Boolean　　　'●再選択フラグ

'--------------------------------
Sub test01()

　Dim MsgResult As Integer

　MsgBox "ＯＫボタンをクリックすると" & vbLf & _
　　　　"ファイル選択画面が表示されますので" & vbLf & _
　　　　"対象ファイルを選択してください"

SelectBook:
　If Application.Dialogs(xlDialogOpen).Show = False Then
　　　MsgBox "キャンセルされました。", , "（￣ロ￣；）！！"
　　　Exit Sub
　End If

　Flag = False
　UserForm1.Show
　If Flag = True Then GoTo SelectBook　　'●DialogOpenに戻る

　Call 次のマクロ

End Sub
'----------------------------------------

Sub 次のマクロ()
　　MsgBox "次のマクロ実行するよ"
End Sub
'-----------------------------------------

'-------以下は、UserForm　---------------------------------

Private Sub UserForm_Initialize()
　Dim i As Integer
　UserForm1.Caption = "シート選択"
　CommandButton1.Caption = "このシートでＯＫ"
　CommandButton2.Caption = "別のブックを再選択"

　ListBox1.Clear
　For i = 1 To Sheets.Count
　　　ListBox1.AddItem Sheets(i).Name
　　　If ActiveSheet.Name = Sheets(i).Name Then
　　　　　ListBox1.ListIndex = i - 1
　　　End If
　Next i
End Sub

'-----UserFormの×ボタンはダメ！の処理　---------

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
　If CloseMode = 0 Then
　　　Cancel = True
　　　MsgBox "Don't Click Me！　 ", vbCritical, "　Caution"
　End If
End Sub

'---------------------------------------------
Private Sub ListBox1_Change()
　　Sheets(ListBox1.List(ListBox1.ListIndex)).Select
End Sub

'---------------------------------------------
Private Sub CommandButton1_Click()
　　Unload UserForm1
End Sub

'--------ブック再選択処理---------------------

Private Sub CommandButton2_Click()
　　Flag = True
　　ActiveWorkbook.Close False
　　Unload UserForm1
End Sub
'---------------------------------------------

シート決定ミスの確認メッセージは抜いてます。
また、”Call 次のマクロ”の位置は
上記コードでは、以前の位置でもいいし
質問者の考えた、CommandButton1のところでもＯＫです。

●別案●
UserFormをモードレスで開くと既出の回答のように
シートを直接扱えますのでListBoxは不要になります。
もちろんコードはちょと違いますが。。。

何れにしろ色んな方法があり面白いですね。
そしてそれをひとつひとつ確かめているエキスパートさんもたいしたものです。
以上です。

お礼

ありがとうございます。
かなり奥が深そうですね。
DialogSheetとはぜんぜん使い方がちがい面食らってばかりです。
これまでUserformはまったく縁が無かったのでこれを機会に勉強してみたいと思います。

ありがとうございました。

回答No.8

noname#262398

#7 です。

全然関係ないプロシージャでも、おかしなコードがあるとそのエラーが出るようです。

VBE の[デバッグ]-[VBAProjectのコンパイル]
を、やってみてください。

それでも動かなければ、分かりかねます。すいません。

お礼

多分、新たに開いてアクティブになったBOOKのモジュールにマクロが存在しないせいではないかと推測し、

.Callback = "AssistantSample2"　となっている3箇所に
.Callback = "アニメTEST.xls!AssistantSample2"　とマクロのあるBOOK名を付け加えて見ました。

無事動きました。
ありがとうございます。

補足

追伸です。

アニメTEST.xls　はご教示のマクロをかいたBOOKですが、BOOK名をコードに書かず、

.Callback = ThisWorkbook.Name & "!AssistantSample2"

とした方が名前の変更にも対応できてベターですね。

回答No.7

noname#262398

いろいろなアイデアが出てますが、さらに別案で、
Officeアシスタントを使ってもいいなら、ユーザーと対話的に作業を進められます。

Sub AssistantSample1()
With Assistant
.On = True
.Visible = True
.Filename = "saeko.acs"
With .NewBalloon
.Heading = "対象確認"
.Text = "対象のファイルを開いてください。"
.Button = msoButtonSetOK
.Show
End With
If Application.Dialogs(xlDialogOpen).Show = False Then
With .NewBalloon
.Heading = "（￣ロ￣；）！！"
.Text = "キャンセルされました。"
.Button = msoButtonSetOK
.Show
End With
Exit Sub
Else
.animation = msoAnimationCheckingSomething
With .NewBalloon
.Heading = "シート選択"
.Text = "開いたら該当のシートを選択して[OK] をクリックしてください。"
.Button = msoButtonSetOK
.Mode = msoModeModeless
.Callback = "AssistantSample2"
.Show
End With
End If
End With
End Sub

Sub AssistantSample2(bln As Balloon, lbtn As Long, lPriv As Long)
bln.Close
With Assistant
Select Case lbtn '=クリックされたボタン
Case msoBalloonButtonOK '[OK]ボタン
.animation = msoAnimationWorkingAtSomething
With .NewBalloon
.Heading = "（￣∇￣) ？ "
.Text = "アクティブシートのデータを取得します。"
.Icon = msoIconAlertQuery
.Button = msoButtonSetYesNoCancel
.Mode = msoModeModeless
.Callback = "AssistantSample2"
.Show
End With

Case msoBalloonButtonYes '[はい]ボタン
.animation = msoAnimationGestureUp
Call 次のマクロ
'.On = False 'アシスタントを消す

Case msoBalloonButtonNo '[いいえ]ボタン
.animation = msoAnimationCheckingSomething
With .NewBalloon
.Heading = "シート選択"
.Text = "シートを選択しなおして[OK] をクリックしてください。"
.Button = msoButtonSetOK
.Mode = msoModeModeless
.Callback = "AssistantSample2"
.Show
End With

Case msoBalloonButtonCancel '[キャンセル]ボタン
.animation = msoAnimationGetWizardy
With .NewBalloon
.Heading = "／(^o^)＼"
.Text = "中止します。"
.Button = msoButtonSetOK
.Show
End With
'.On = False 'アシスタントを消す
End Select
End With

End Sub

Sub 次のマクロ()
MsgBox "次のマクロ"
End Sub

Animationを使ったり、半分お遊びなので、
ヒマあったら実行してみてください。

お礼

ありがとうございました。
アシスタントのアニメーションは使ったことがありませんでした。
面白そうなのでさっそく試してみました。
ところが、対象のBOOKを開いてからOKすると
「マクロ、AssistantSample2がみあたりません」というエラーになってしまいます。

回答No.6

masa_019

こんにちは。

期待に沿えたようで、良かったです。
消し方はその通りですが、念のため On Error でトラップしておいた方がいいかも。
ちなみに、コマンドバーを×で消す動作は、コマンドバーのVisibleプロパティをFalseに設定するのと同じで、Deleteは ツール - ユーザー設定 から削除する動作になります。

お礼

ご丁寧にありがとうございました。
助かりました。

回答No.5

ki-aaa

今日わ
ファイルを開いて、すぐに実行しないようにするには、
Application.OnTime を使ったらどうでしょう。

Else
ThisWorkbook.Sheets("Sheet1").Range("A1").ID = ActiveWorkbook.Name
呼び出し時間 = Now + TimeValue("00:00:08")
Application.OnTime 呼び出し時間, "決定"
End If
End Sub

お礼

有難うございます。

回答No.3

end-u

簡易的な方法としては、Application.InputBoxメソッドが考えられます。
シートタブではなく、必ずセルを選択してもらう必要がありますが。

Sub test1()
　　Dim wb As Workbook
　　Dim r　As Range
　　Dim x

　　x = Application.GetOpenFilename("ExcelFile,*.xls")
　　If VarType(x) = vbBoolean Then Exit Sub
　　On Error Resume Next
　　Set wb = Workbooks.Open(CStr(x))
　　On Error GoTo 0
　　If wb Is Nothing Then
　　　　MsgBox "openメソッド失敗"
　　Else
　　　　On Error Resume Next
　　　　Set r = Application.InputBox("該当シートの適当なセルを選択", Type:=8)
　　　　On Error GoTo 0
　　　　If Not r Is Nothing Then
　　　　　　r.Worksheet.Activate
　　　　　　Call msg1
　　　　End If
　　End If

　　Set r = Nothing
　　Set wb = Nothing
End Sub

Sub msg1()
　　MsgBox ActiveSheet.Name
End Sub

他にはWshShellのPopupメソッドを使う方法もあったりします。

Sub test2()
　　Dim wb As Workbook
　　Dim x

　　x = Application.GetOpenFilename("ExcelFile,*.xls")
　　If VarType(x) = vbBoolean Then Exit Sub
　　On Error Resume Next
　　Set wb = Workbooks.Open(CStr(x))
　　On Error GoTo 0
　　If wb Is Nothing Then
　　　　MsgBox "openメソッド失敗"
　　Else
　　　　Application.OnTime Now, "msg2"
　　　　Set wb = Nothing
　　End If
End Sub

Sub msg2()
　　Dim x As Long

　　Application.Cursor = xlNorthwestArrow
　　x = CreateObject("WScript.Shell") _
　　　　.Popup("シートを選択してください.", , "title", vbOKCancel Or vbSystemModal)
　　Application.Cursor = xlDefault
　　If x = 1 Then
　　　　MsgBox ActiveSheet.Name
　　End If
End Sub

#私の環境(xp/2003)ではOnTimeメソッド経由でないと不安定な感じでしたので入れてますが
#本来はダイレクトにいけるかも。

お礼

ありがとうございます。
こういうやり方もあるんですね、とても勉強になります。

回答No.2

myRange

こんにちは、エキスパートさん。
毎日色んなことやってるのですねぃ。(^^;;;

シートを確認しながらということであれば、
エキスパートさんもお得意のUserFormがいいかも。

ListBoxとCommandButtonをひとつずつ乗せてるUserFormを用意して
以下のコードを実行してみてください。

'--------- 標準モジュール -----------------------
Sub test01()
　MsgBox "ＯＫボタンをクリックすると" & vbLf & _
　　　　"ファイル選択画面が表示されますので" & vbLf & _
　　　　"対象ファイルを選択してください"
　If Application.Dialogs(xlDialogOpen).Show = False Then
　　　MsgBox "キャンセルされました。", , "（￣ロ￣；）！！"
　　　Exit Sub
　End If

　UserForm1.Show

　Call 次のマクロ
End Sub
'----------------------------------------
Sub 次のマクロ()
　　MsgBox ActiveSheet.name
End Sub
'-----------------------------------------

'-------以下は、UserForm　------------------------

Private Sub UserForm_Initialize()
　Dim i As Integer
　ListBox1.Clear
　For i = 1 To Sheets.Count
　　　ListBox1.AddItem Sheets(i).Name
　　　If ActiveSheet.Name = Sheets(i).Name Then
　　　　　ListBox1.ListIndex = i - 1
　　　End If
　Next i
End Sub
'---------------------------------------------
Private Sub ListBox1_Change()
　　Sheets(ListBox1.List(ListBox1.ListIndex)).Select
End Sub
'---------------------------------------------
Private Sub CommandButton1_Click()
　　Unload UserForm1
End Sub
'----------------------------------------------

UserFormのListBoxにシート名を表示させ
シート名をクリックするたびに選択シートをアクティブにし
該当シートであれば、ＯＫボタン

流れだけ分かればいいということで少し手を抜いてます。。

昨日、洗車したのですが、今朝もうっすらと灰が。。。
これがなければいいところなのですがねぃ。(^^;;;
以上です。

お礼

昨日はバタバタしておりお礼がおそくなりました。
なるほどUserFormを使えばいいわけですか。

実は、いつも旧式のDialogboxでお茶を濁してばかりで、UserFormって一度も使ったことがないんです。

試したら上手くいきました！
有難うございます。

で、Userformを使う場合、ひらいたBOOKではないことがわかり、キャンセルする場合はどのようにしたらよいのでしょうか？
右上の×をクリックしても、「次のマクロ」が実行されてしまうようです。

補足

いろいろ試してみました。

キャンセル対応として以下のようにしてみました。

標準モジュール
Sub test01()　から　「Call 次のマクロ」　の文言を削除

UserForm
UserFormにコマンドボタンをもう一つ追加（CommandButton2）

Private Sub CommandButton1_Click()
Unload UserForm1
Call 次のマクロ
End Sub
に修正

Private Sub CommandButton2_Click()
Unload UserForm1
End Sub
をあらたに追加。

これで正しいでしょうか？

回答No.1

cistronezk

マクロの実行中にシートをユーザに直接選択させることはできないでしょう。
代わりに以下のようにしてはどうでしょう。

Sub test01()
Dim i As Integer, sht_no As Integer
Dim msg As String

MsgBox "対象のエクセルファイルを開いてください。"
If Not Application.Dialogs(xlDialogOpen).Show Then Exit Sub

'Inputbox用のメッセージを作成
For i = 1 To ActiveWorkbook.Worksheets.Count
msg = msg & i & ":" & ActiveWorkbook.Worksheets(i).Name & vbCrLf
Next

'ユーザにActiveにするシート番号を選択させる
Do While sht_no < 1 Or sht_no > ActiveWorkbook.Worksheets.Count
sht_no = Val(InputBox("■下記から対象シートの番号を選択してください" & vbCrLf & msg))
Loop
ActiveWorkbook.Worksheets(sht_no).Activate

Call 次のマクロ
End Sub

お礼

cistronezkさま、さっそくありがとうございます。
InputBoxを使う手は思いつきませんでした。
ただ、これだと対象とするシートを視認することは出来ないので、ユーザーはシート名だけで判断しなければいけませんよね。そこがちょっと・・・。

現在は以下のようにやっているのです。

Sub 開始()
MsgBox "対象のファイルを開いてください。" _
& vbCr & "開いたら該当のシートを選択してください。" _
& vbCr & "" _
& vbCr & "再度このファイルに戻り「決定ボタン」を押して下さい。", , " 対象確認"
If Application.Dialogs(xlDialogOpen).Show = False Then
MsgBox "キャンセルされました。", , "（￣ロ￣；）！！"
ThisWorkbook.Sheets("Sheet1").Range("A1").ID = ""
Exit Sub
Else
ThisWorkbook.Sheets("Sheet1").Range("A1").ID = ActiveWorkbook.Name
End If
End Sub

Sub 決定()
x = ThisWorkbook.Sheets("Sheet1").Range("A1").ID
If x = "" Then
MsgBox "対象ファイルが開かれていません！", , "Σ（￣ロ￣lll) "
Exit Sub
End If
Workbooks(x).Activate
If MsgBox("このシートのデータを取得します。", vbYesNo + vbQuestion, "（￣∇￣) ？ ") = vbYes Then
Call 次のマクロ
Else
MsgBox "中止します。", , "／(^o^)＼"
End If
End Sub

これだと見て確認できますから。
ただ、一旦もとのBOOKに戻らなければボタンを押せないのが気に入りません。
ボタンを押す代わりに何らかの方法でSub決定を作動できればいいと思うのですが、方法がわかりません。