１つのワークシートでイベントを続けて実行する方法

質問

こんにちは。
最近独学でマクロ・VBAの勉強を始めた者です。
会社にて、各出先から私の部署へ提出させる書類の雛形を
マクロを駆使しながら作成していますが、行き詰ってしまいました。

１つのワークシートオジェクトに『Private Sub Worksheet…』のActivate→Changeの順で実行したく、
標準モジュールのようにEnd Subで一旦区切ってから続けて記述してみましたが上手く行きません。
（Activateは実行されるが、Changeは実行されない）

先述の通り超初心者のため、根本的に理解していない部分等あるかと思います。
さらに当サイトは初めて利用するので、質問の仕方に不備がありましたら申し訳ありません。
解決策をご教示お願い致します。

　　　　　　　　　　　　　　　　　　　　　　記

１．シートがアクティブになった際、A1が空白セルの場合はインプットボックスで入力させる

Private Sub Worksheet_Activate()
If Range("A1") = "" Then

Dim ans As String
ans = InputBox("担当者名を入力して下さい", "担当者名", "")

If ans <> "" Then
Range("A1").Value = ans
End If
End If

End Sub

２．A1に文字が入力されたら、下記※を実行する（←Changeイベント）

※ブック保護解除→A1に入力した文字をシート名に入力→再度ブック保護

（計算式が多数入っているため、シートおよびブックは保護しています）

Sub ブック保護解除()
ActiveWorkbook.Unprotect Password:="1111"
End Sub

Sub シート名変更()
　On Error GoTo ERR_HANDLER
ActiveSheet.Name = ActiveCell.Value
Exit Sub
ERR_HANDLER:
MsgBox "選択されているセルの値はシート名にできません。" _
& vbCrLf & "他のセルを選択するか、データを修正してください。"
End Sub

回答No.3

tom04 · ベストアンサー

No.1です。
補足を読ませていただきました。

（1）複数Sheetの場合ですが、（仮にSheet数が複数だとします）
単純に
＞If ActiveSheet.Name = "担当１" Then
の行を
＞If ActiveSheet.Name = "担当１" or ActiveSheet.Name = "担当２" Then
といった具合でも良いのですが、これだとSheet数が増えた場合は大変だと思います。

そこでSheetのインデックス番号を利用してみてはどうでしょうか？
（担当１・担当２のSheetがSheet見出しの左から順にあるとします）

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim i As Long
i = ActiveSheet.Index
If i <= 2 Then
If Range("A1") = "" Then
Dim ans As String・・・以下続く

のようにすれば「or」でつなぐ必要はありません。
インデックス番号はSheet見出しに配置してあるSheet順で左から1・2・・・となります。

（2）エラーの件ですが、
単純にA1セル以外でDeleteキーを押した場合はメッセージボックスを表示しないようにすれば良いだけですかね？

※　余計なお世話かもしれませんが、A1セルを空白にした場合はSheet名も「担当○」のように変えてみました。

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 1 And Target.Column = 1 Then
'保護解除
ActiveWorkbook.Unprotect Password:="1111"

'シート名入力
If Range("A1") <> "" Then
ActiveSheet.Name = Range("A1").Value
'再度保護
ActiveWorkbook.Protect Password:="1111"
Exit Sub
Else
MsgBox "選択されているセルの値はシート名にできません。" _
& vbCrLf & "他のセルを選択するか、データを修正してください。"
ActiveSheet.Name = "担当" & StrConv(ActiveSheet.Index, vbWide)
End If
End If
End Sub

こんな感じですかね？

※　上記コードは大前提として各担当SheetがSheet見出しの左側から配置してあるとしてのコードです。
（2）が的外れかもしれませんので間違っていたらごめんなさいね。m(_ _)m

お礼

お返事が大変遅くなり申し訳ありません。
No.3・No.4で教えて頂いたコードに書き換えてみると、
今回はエラーも無く完璧に希望通りの処理になりました！

＞A1セルを空白にした場合はSheet名も「担当○」のように変えてみました。
こちらも教えて頂いて大変助かりました。

VBAは奥が深く、まだまだ学ぶ事がたくさんありそうです。
また機会がありましたらご助言頂けると嬉しいです。
本当にありがとうございました（＾＾）

回答No.4

tom04

No.1・3です！
たびたびごめんなさい。

前回書き忘れたので・・・

Worksheet_Changeイベントは各Sheetそれぞれに設定しなければ動作しませんので気を付けてください。

すべてのSheetで同じ動作であればそれぞれのSheetにコピー＆ペーストすれば良いだけですけど・・・

何度も失礼しました。m(_ _)m

回答No.2

imogasi

エクセルの質問には、ブックとシートをはっきりさせて質問のこと。
そしてＶＢＡの場合は、コードを何処に置いているのかをはっきりさせること。
何処のブックの標準モジュールへ
どのブックのＴｈｉｗｏrｋBookの
どのブックのどのシートのシートイベントプロシージュアーに
書いて居るか。
シートの場合は開いているシートのシートモジュールに
同一ブック内の他シート（全シートドレでも）の場合はＴｈｉｓＷｏｒｋｂｏｏｋのところへイベントプロシージュアーを書かないといけない。
他ブックなどのイベントを、自分のところのコードで察知することは出来ない。
だか初心者という事で、そういう点が心配だ。
ーー
＞各出先から私の部署へ提出させる書類の雛形をマクロを駆使しながら作成していますが
こんなことにＶＢＡの出番は余りあるとは思えない。何をしたいのか？
コードを離れて、やりたいことを文章で表現してみたら。
ーー
＞各出先から私の部署へ提出させる書類の雛形を・・
それら各々が（質問者の処理にかかる直前には）、別ブックになるのか、別シートになる（する）のか。
そういうことも書いてない。
＞Sub ブック保護解除()
この点は改めて質問したら・急に保護の話が出たりするが、初心者には難しい点と思う。
ＶＢＡではシートのセルデータのとらえ方など基本的なことは沢山あるはず、それらは済んだと思うのか。

補足

ご指摘ありがとうございます。
肝心な部分を書き忘れていたようで申し訳無いです。

※全て同一ブック内での作業となります※

＞同一ブック内の他シート（全シートドレでも）の場合は
ＴｈｉｓＷｏｒｋｂｏｏｋのところへイベントプロシージュアーを書かないといけない。

これが抜けていたので動作しなかったようです。No.1さんに教えて頂き解決しました。

＞こんなことにＶＢＡの出番は余りあるとは思えない。何をしたいのか？

各出先に対してブックを配布します。
構成は：総括表、その内訳となるシート：担当者１、担当者２、担当者３…　と人数に応じてシートを作成しています。

出先にはＰＣ操作に慣れていない人が多いので、
入力手順を出来るだけ減らし、直感的な操作で完結するようにしたいです。
それを実現するためにはマクロは必須と考えています。

質問文に記したコードの内容は以下の通りです。
お手数ですが、詳細はNo.1さんへの補足をご覧願います。

１．【This Workbook】に記述
シート１を、アクティブにした際、A1が空白セルの場合はインプットボックスを出し、その値(担当者名)をA1へ入力させる。

２．【該当シート(担当１)】に記述
A1に入力した内容＝シート名とする。（担当者の名前が入っているシートを作りたい）
（ただし、ブック保護がかかっているので【保護解除→２の動作→再度ブック保護】が一連の動作になります）

＞それら各々が（質問者の処理にかかる直前には）、別ブックになるのか、別シートになる（する）のか。

各出先にはこちらからメール配布した雛形に必要事項を入力してもらい、
それが私の元へメールで返信されます。あとは印刷してファイルを保存するのみです。
A1に入力した担当者名＝シート名としたいのは、
あくまで各出先からの要望事項であり、その後私が行う作業と紐付きではありません。

回答No.1

tom04

こんばんは！
外しているかもしれませんが・・・

Workbook_SheetActivate　イベントを使ってはどうでしょうか？
あるSheetがアクティブになった時に
アクティブSheetの「A1セルが空白の場合・・・」のマクロが走るようにします。

SheetにWORKSheet_Change　イベントをあるSheetに設定しておきます。

WorkSheet_Change　イベント　をSheet1に設定しているの場合は

Alt+F11キー　→　画面左下の「This Workbook」をダブルクリック　→　
「Workbook」・「SheetActivate」イベントを選択

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ActiveSheet.Name = "Sheet1" Then '←「Sheet1」の部分は実際のSheet名に！
If Range("A1") = "" Then
Dim ans As String
ans = InputBox("担当者名を入力して下さい", "担当者名", "")
If ans <> "" Then
Range("A1").Value = ans
End If
End If
End If
End Sub

といった感じにしてみてはどうでしょうか？
これでSheet1がアクティブになった場合のみ　A1セルが空白であれば・・・というマクロが走ります。

あとはWORKSheet_Changeイベントが実行されると思います。

的外れならごめんなさいね。m(_ _)m

補足

今気付きましたが、質問文が途中で切れていました…
にも関わらず、親身なご回答をありがとうございます。

教えて頂いたWorkbook_SheetActivateを実践してみたところ、
希望通りの処理になりました！
Workbook_SheetActivateイベントは全く頭に無かったので
大変勉強になりました。

後出しで恐縮なのですが、Workbook_SheetActivateイベントは
複数のシートを指定する事も可能でしょうか？

また、別の問題が発生していまいました。
該当シート"担当１"のいずれかのセルでDeleteキーを押すと、
あらかじめ指定したエラーメッセージが出てきてしまいます…
（Changeイベント："選択されているセルの値は～…"の部分）

もし、おかしな部分があればご指摘頂けるとありがたいです。
質問の仕方が悪く、長引かせてしまい申し訳ありません。

【This Workbook】に以下記述
～～～～～～～～～～～～～～～～～～～～～～～～～～
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'担当者１の氏名入力
If ActiveSheet.Name = "担当１" Then
If Range("A1") = "" Then
Dim ans As String
ans = InputBox("担当者名を入力して下さい", "担当者名", "")
If ans <> "" Then
Range("A1").Value = ans
End If
End If
End If
End Sub
～～～～～～～～～～～～～～～～～～～～～～～～～～

【該当シート(担当１)】に以下記述
～～～～～～～～～～～～～～～～～～～～～～～～～～
Private Sub Worksheet_Change(ByVal Target As Range)
'保護解除
ActiveWorkbook.Unprotect Password:="1111"
On Error GoTo ERR_HANDLER
'シート名入力
ActiveSheet.Name = Range("A1").Value
'再度保護
ActiveWorkbook.Protect Password:="1111"
Exit Sub
　　ERR_HANDLER:
　　MsgBox "選択されているセルの値はシート名にできません。" _
& vbCrLf & "他のセルを選択するか、データを修正してください。"
End Sub
～～～～～～～～～～～～～～～～～～～～～～～～～～