エクセル マクロ

質問

フィルタ機能を実行中（行が歯抜けになっている状態）では
ファイルの上書き保存が出来ない仕様にできないでしょうか？
その場合メッセージボックスの表示が欲しいです
対象シートは全部(Thisworkbook）です

回答No.1

cj_mover · ベストアンサー

こんにちは。

> フィルタ機能を実行中（行が歯抜けになっている状態）では
> ファイルの上書き保存が出来ない仕様にできないでしょうか？

マクロが有効な場合に限る、という条件でしたらば、可能です。

> その場合メッセージボックスの表示が欲しいです

一応、
「フィルター抽出状態のワークシートが１つ以上見つかった場合は」
「フィルター抽出状態を解除しておくことが求められます。」というメッセージを表示して
●[ＯＫ]を選んだ場合
　　「すべてのワークシートに対してフィルター抽出状態を解除」してから
　　■上書き保存する■
●[キャンセル]を選んだ場合
　　■上書き保存しない■
という風に強制的なものを書いてみました。

但し、Excelに慣れた人であれば、
[デザインモード]に切り替えることで、一時的にマクロを無効にしてから、
手動での上書き保存が可能であることに気が付く人もいるかも知れません。
周囲の状況を見て、この方法の採否について検討してください。
「わざわざマクロを無効にするような人はいない」とか
「内規としてデザインモードを禁止することが可能」とか
職場の環境に期待して構わないと判断されたなら、
十分に有効な方法であると考えます。
逆に、デザインを含めた全権的な編集権限を持つユーザー（この場合は質問者さん）は、
[デザインモード]に切り替えることで、
フィルター抽出状態のままでも上書き保存が可能になります。

> 対象シートは全部(Thisworkbook）です

「フィルター抽出状態であるか確認するべき対象は、Thisworkbookのすべてのシートです」
とか、読み下して解釈しています。

' ' ******************** ThisWorkbook モジュール

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
　　Dim oWsh As Worksheet

' ' すべてのワークシートに対してフィルター抽出状態を確認
　　For Each oWsh In ThisWorkbook.Worksheets
　　　　If oWsh.FilterMode Then Exit For
　　Next

' ' フィルター抽出状態のワークシートが１つ以上見つかった場合は
　　If Not oWsh Is Nothing Then
　　　　　　' ' ●[ＯＫ][キャンセル]を選ぶメッセージボックス
　　　　If MsgBox("フィルター抽出状態のシートがあります。" & _
　　　　　　vbLf & vbLf & "このブックを上書き保存するには、" & _
　　　　　　vbLf & "フィルター抽出状態を解除しておくことが求められます。" & _
　　　　　　vbLf & vbLf & "フィルター抽出状態をすべて解除するマクロを実行した後、" & _
　　　　　　vbLf & "上書き保存しますか？" & _
　　　　　　vbLf & vbLf & "（キャンセルを選ぶと上書き保存は実行されません。）", _
　　　　　　vbOKCancel Or vbInformation, ThisWorkbook.Name & "：上書き保存時の注意") _
　　　　　　　　= vbOK Then
　　　　　　' ' ●[ＯＫ]を選んだ場合
　　　　　　' ' すべてのワークシートに対してフィルター抽出状態を解除
　　　　　　For Each oWsh In ThisWorkbook.Worksheets
　　　　　　　　If oWsh.FilterMode Then oWsh.ShowAllData
　　　　　　Next
　　　　　　' ' ■上書き保存する■

　　　　Else ' ' ●[キャンセル]を選んだ場合
　　　　　　' ' ■上書き保存しない■
　　　　　　Cancel = True
　　　　　　Set oWsh = Nothing　　'　　後始末
　　　　End If
　　Else
' ' フィルター抽出状態のワークシートが見つからなかった場合
　　　　' ' 必要な処理があれば、ココに
　　End If
End Sub

' ' ********************

お礼

希望通りのものでした。
ご回答ありがとうございました。