エクセル 未入力セルがあると保存できない設定

エクセルVBAで、入力必須項目を設定し、未入力セルがある場合は保存ができないようにしたいのですが教えていただけませんか。

ブックには複数シートが存在し、入力必須項目を設定したいのはsheet1のみ。
sheet1のA1,A5, A9, B1, B5, B9の6つのセルはすべて必須入力。
未入力がある場合はファイルを閉じる時に保存が出来ないようにする。
出来ればどのセルが未入力なのかエラーメッセージが出るとベスト。
6項目すべて入力できていれば通常通りファイル保存して閉じることができる。
このブック作成者がブック作成、変更ができるようにしたい(ファイルを作成、変更する時はブランクなのでエラーメッセージが出てファイル保存ができないため)。

No.3 ベストアンサー 回答者： tom04 回答日時： 2012/04/18 13:41

No.1です！

前回の回答は質問にある
＞未入力セルがあると保存できない設定
ではなかったですね！
「未入力セルがあれば、閉じれないようにする！」になっていました。

今回は未入力セルがあれば、「保存」・「閉じる」の両方が出来ないようにしてみました。
（「保存」・「閉じる」の操作の場合に同じコードにしているだけです）

Private Sub Workbook_BeforeClose(Cancel As Boolean) 'この行から
Dim k As Long
Dim str, buf As String
Dim myArray As Variant
myArray = Array("A4", "B7", "C8", "D19") '←好みの数だけセル番地を格納する
For k = 0 To UBound(myArray)
If Worksheets("Sheet1").Range(myArray(k)) = "" Then
str = WorksheetFunction.Substitute(Range(myArray(k)).Address, "$", "")
M = M + 1
buf = buf & str & ","
End If
Next k
If M > 0 Then
MsgBox "Sheet1の" & vbCrLf & Left(buf, Len(buf) - 1) & "セルが" & vbCrLf & "未入力です。"
Worksheets("Sheet1").Activate
Cancel = True
End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim k As Long
Dim str, buf As String
Dim myArray As Variant
myArray = Array("A4", "B7", "C8", "D19") '←好みの数だけセル番地を格納する
For k = 0 To UBound(myArray)
If Worksheets("Sheet1").Range(myArray(k)) = "" Then
str = WorksheetFunction.Substitute(Range(myArray(k)).Address, "$", "")
M = M + 1
buf = buf & str & ","
End If
Next k
If M > 0 Then
MsgBox "Sheet1の" & vbCrLf & Left(buf, Len(buf) - 1) & "セルが" & vbCrLf & "未入力です。"
Worksheets("Sheet1").Activate
Cancel = True
End If
End Sub 'この行まで

※　「This Workbook」にコピー＆ペーストしてください。

ご希望の方法でなかったらごめんなさいね。m(__)m

この回答へのお礼

有難うございました。無事期限までにファイル完成しました！
何とお礼を言っていいか。
つたない私の頼みを聞いてくださって感謝です！！

お礼日時：2012/04/18 14:26

No.4 回答者： keithin 回答日時： 2012/04/18 13:46

＞言葉足らずでしたが、入力必須が全部埋まるまでファイルを閉じさせないようにしたいのです

「保存をさせない」と，「ブックを閉じさせない」とでは違う仕事なので，マクロも当然別になります。
それとも？「保存をさせない」のご質問を撤回して「閉じさせない」だけを実現したくなったという事でしょうか。それなら一回ご相談を閉じて，新たなご質問として投稿し直していただいた方が良いと思えます。



とりあえず「保存させず，閉じさせない」の２本立てに変えたいというお話だとして。

たとえばThisWorkbookに，回答２のマクロとセットで

private sub workbook_beforeclose(Cancel as boolean)
　thisworkbook.save
　if not thisworkbook.saved then cancel = true
end sub

などのように仕込んでみます。




＞マクロを強制的に有効にさせたい

マクロを有効にするためにマクロを使うって，それは缶詰の中に缶切りを入れておくようなモノです。そういう方法はありません。
通常はエクセル自体の設定で「マクロのセキュリティ」によって，管理します。


＃参考
ブックはとりあえず開けるけど，マクロを有効にしないと「仕事が出来ない」ように仕込んで使わせるような事なら，やれば出来ます。
元のご相談とはちょっとかけ離れた課題なので，少し何が出来るか考えてみたり，別途ご相談を投稿してみてください。

この回答へのお礼

すみません。保存させないのではなく、ブックを閉じさせない、のが正解です。

お礼日時：2012/04/18 13:49

No.2 回答者： keithin 回答日時： 2012/04/18 02:13

＞保存ができないようにしたい

thisworkbookシートに次のように作成しておきます。

private sub Workbook_BeforeSave(byval SaveAsUI as boolean, cancel as boolean)
　dim h as range
　dim res as string

　for each h in worksheets("Sheet1").range("A1:B1,A5:B5,A9:B9")
　　if h = "" then
　　res = res & h.address(false, false) & " "
　　end if
　next
　if res = "" then exit sub

　msgbox "Fill in blanks" & vblf & replace(trim(res), " ", ",")
　cancel = true
end sub



＞作成者

方法１）
ブックを、マクロを無効で開いて編集し、保存します。

方法２）
sub macro1()
application.enableevents = false
end sub
というマクロを実行してから保存します。

方法３）
sub macro2()
application.enableevents = false
thisworkbook.save
end sub
というマクロで保存させます。

この回答への補足

色々勝手にお願いしてすみません。
今会社でテストしたところ、入力必須の入力がない場合、エラーメッセージが出ますが、その後ファイルも閉じてしまいます。
言葉足らずでしたが、入力必須が全部埋まるまでファイルを閉じさせないようにしたいのです。

補足日時：2012/04/18 10:00

この回答へのお礼

こちらもありがとうございました。できました。
作成者についてはマクロ無効が私にとっては一番いい手だと思うのですが、実はあと追加でお願いです。このファイルは複数作業者に渡すんですが、入力必須させる為に、マクロを強制的に有効にさせたいんですが、上記マクロ内容に追加できますか。でもその場合、作成者はマクロ無効でファイルを開くこともできないですよね。。

お礼日時：2012/04/18 06:44

No.1 回答者： tom04 回答日時： 2012/04/17 22:53

こんばんは！

参考になるかどうかわかりませんが・・・

Alt+F11キー　→　VBE画面の左下の「This Workbook」をダブルクリックして
↓のコードをコピー＆ペーストしてみてください。

Private Sub Workbook_BeforeClose(Cancel As Boolean) 'この行から
Dim j, k, M As Long
Dim str, buf As String
Dim myArray As Variant
myArray = Array(1, 5, 9)
For j = 1 To 2
For k = 0 To 2
If Worksheets("Sheet1").Cells(myArray(k), j) = "" Then
str = WorksheetFunction.Substitute(Cells(myArray(k), j).Address, "$", "")
M = M + 1
buf = buf & str & ","
End If
Next k
Next j
If M > 0 Then
MsgBox "Sheet1の" & vbCrLf & Left(buf, Len(buf) - 1) & "セルが" & vbCrLf & "未入力です。"
Worksheets("Sheet1").Activate
Cancel = True
End If
End Sub 'この行まで

お役に立ちますかね？m(_ _)m

この回答への補足

keithinさんにもお願いしましたが、どちらかの方に回答頂けると嬉しいです。
追加で、このファイルは複数作業者に渡すんですが、入力必須させる為に、マクロを強制的に有効にさせたいんですが、上記マクロ内容に追加できますか。でも問題は、作成者はどうやって編集するのか、という事なんです。

補足日時：2012/04/18 07:09

この回答へのお礼

ありがとうございます。出来ました。
ただ私の伝え方の問題ですが、私が指定した入力必須セルはサンプルなので実際は同じ行番号ではないんです。A4,B7,C8,D19と言った感じで。

お礼日時：2012/04/18 06:40