ExcelVBAで必須セルを入力しないと保存不可設定したが、未入力有でメールして来られる。対策は？

質問

知恵袋にも質問しましたが、回答を頂けるか不安で、こちらにも質問します。
ExcelのVBAで、先日、次の要望(1)～(5)を満たすコード（下記記載）を教えて頂き、大変助かりました。
ただ、新たな問題（最後に書いてます）が発生しましたので、ご回答をお願いいたします。
(1)特定のセル（A1,B5,C10等）を入力しないとファイルを保存できない設定
(2)全て入力してたら、閉じる時に普段どおり、『「保存しますか？」の質問に「はい」「いいえ」「キャンセル」』のメッセージボックスが出るように
(3)入力してなかったら、閉じる時に『「未入力ですので、保存できません」』の質問に「保存しません」「キャンセル」』のメッセージボックスが出るように
(4)上書可能で、上書きする時に特定のセル（D12）にその時の日を入力したいが、その日には条件があって、16：00より前ならその日、16：00以降なら翌日に入力されるように
(5)また、作成者がそこを空白のまま保存できないので、作成者については、その制限がかからない方法

ブックモジュール[ThisWokbook]に
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Application.UserName = ThisWorkbook.BuiltinDocumentProperties("Author") Then Exit Sub '許可するユーザー名
Dim myRng As Range
Dim myStr As String
With Worksheets("Sheet1")
Set myRng = Union(.Range("A1"), .Range("B5"), .Range("C10"))
End With
If WorksheetFunction.CountA(myRng) < 3 Then
Cancel = True
myStr = "未入力セルがあります" & vbCrLf & _
"[OK....保存しないで終了]" & vbCrLf & _
"[キャンセル..編集に戻る]"
If MsgBox(myStr, vbOKCancel) = vbOK Then
ThisWorkbook.Close False
End If
End If
Worksheets("Sheet1").Range("D12") = Date + IIf(Time < TimeValue("16:00"), 0, 1)
End Sub

新たな問題ですが、このExcelファイルは依頼書で各営業が全て入力してからメールでこちら部署に送って来ます。そこで、営業が上書きせずに（必須項目未入力有）、Excelの「メニューバー（？）」の「ファイル」「送信」「メールの宛先」でファイルを送って来て、困ってます。何か対策はないでしょうか？上記コードを生かしたコードを教えていただくと助かります。

回答No.3

noname#89471 · ベストアンサー

こんにちは。

＞ 営業が上書きせずに（必須項目未入力有）、Excelの「メニューバー（？）」の「ファイル」「送信」「メールの宛先」で
＞ ファイルを送って来て、困ってます。
-------------------
編集途中(未入力項目有り)でも、上記の操作でメールが送れてしまう...
とのことでよろしいでしょうか？

私、あまり詳しくないので、参考ということで、ご理解ください。
また、もっとよいやり方があるかもしれませんので、以後の回答をご参考にしてください。

[ファイル]、[送信]のメニューは
Application.CommandBars("file").Controls("送信(&D)").Enabled = False
で無効にできるようです。
ただし、ユーザー設定で、メニューの"送信(&D)"を編集されてしまっていると、無効(または有効)にはできません。

案として、元のコードを流用させていただき...

ワークブック開いたとき[送信]のメニューを無効
-------------------
Private Sub Workbook_Open()
Application.CommandBars("file").Controls("送信(&D)").Enabled = False
End Sub

ワークブック閉じたとき[送信]のメニューを有効
-------------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.CommandBars("file").Controls("送信(&D)").Enabled = True
End Sub

ワークシート変更されたときのイベント
(未入力ありの場合は、[送信]のメニューを無効、未入力なしの場合は[送信]のメニューを有効)
-------------------
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim myRng As Range

With Worksheets("Sheet1")
Set myRng = Union(.Range("A1"), .Range("B5"), .Range("C10"))
End With

If WorksheetFunction.CountA(myRng) < 3 Then
Application.CommandBars("file").Controls("送信(&D)").Enabled = False
Else
Application.CommandBars("file").Controls("送信(&D)").Enabled = True
End If
End Sub

あとは、n_na_tto様がおっしゃってらっしゃるように、"営業の方に必要部分を入力することを徹底させる"ことが
先ず第一に必要なことと思います。仕事ですから。

私も、勉強になりました。
ありがとうございました。

お礼

ご回答ありがとうございました。
大変助かりました！！

回答No.2

n_na_tto

無駄なUnionを使っていたので、恥ずかしいので修正します。
さらに「保存しません」の選択肢をなくすと、こんな感じです。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Application.UserName = ThisWorkbook.BuiltinDocumentProperties("Author") Then Exit Sub '許可するユーザー名
Dim myRng As Range
Set myRng = Worksheets("Sheet1").Range("A1,B5,C10")
If WorksheetFunction.CountA(myRng) < 3 Then
　Cancel = True
　MsgBox "A1,B5,C10すべて入力してください", vbOKOnly
End If
End Sub

お礼

追記していただきまして、ありがとうございます。
大変勉強になりました！

回答No.1

n_na_tto

n_na_ttoです。
お急ぎのようですね。
IIFの部分だけ私のコードと違いますが、
ご自分で追加されたのですか？

コードの問題というより、仕様を考えるべきだと思います。
なぜなら

>「未入力ですので、保存できません」の質問に「保存しません」
を選択して、
>営業が上書きせずに
終了すれば当然元のデータ未入力のまま。
そういう仕様でコードを書きました。
新しく「保存しません」の選択肢をなくしたい、ということですか？

あと、営業の方に必要部分を入力することを徹底させるとか...

お礼

ご回答ありがとうございました。
とてもアナログな会社で、Excelに詳しい人はいないわりには、営業の要求が多かったり、不備の多い書類を出されたりで、困ってまして、勿論、必要部分を入力することを徹底出来ない環境なのです。
面倒な質問で本当にすみません。