フィルター解除を促すメッセージ

いつもお世話になります、

フィルターがついたままファイルを上書きして保存しようとする際に フィルタ解除して下さい というようなメッセージを表示させたいのですが そんな方法はあるのでしょうか？
おそらくシートにコードを書くのだと思いますが お時間ある方いらっしゃいましたら、ご教示願います。

質問者からの補足コメント

• 少し考えましたら、シートじゃなくて、標準モジュールでしょうか？上書き保存する時のコードの前に、if〜のような条件分岐したコードを書くのでしょうか？

    補足日時：2015/08/29 13:25

No.2 ベストアンサー 回答者： WindFaller 回答日時： 2015/08/30 10:37

こんにちは。

>Err.Raise 513なんて初めて見ました。意図してないものがあった場合、エラーを発生させる？？ってことなんでしょうか。

Err.Raise で、わざと、ユーザー定義エラーを発生させています。奇をてらったわけではなかったのですが、Goto を使わずに、　Resume Nextを活かす方法として、使ったものです。全シートを当たる方法として、別に他の方法でも良かったのですが、フィルターあるなしに関わらず、総当りしなくても済む方法として、この方法を使いました。
なお、FilterMode(見えない行がある状態) は、オートフィルタだけではありませんが、その点は、未だ不具合が存在しているかもしれません。

No.1 回答者： WindFaller 回答日時： 2015/08/29 20:31

こんばんは。

「フィルターがついたままファイルを上書きして保存しようとする際に フィルタ解除して下さい」
というよりも、フィルタを解除させてしまったほうが早いとは思います。
ただ、私の記憶では、フィルターというのは、何もオートフィルターだけではないようなので、以下の場合、それらに該当できるかは試しておりません。
標準モジュールでも可能ですが、オートメーション化した時に、標準モジュールですと、素通りしてしまいます。

'//
'Thisworkbook モジュール

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sh As Worksheet
On Error GoTo ErrHandler
For Each sh In ThisWorkbook.Worksheets
　If Not sh.AutoFilter Is Nothing Or sh.FilterMode Then
　 Err.Raise 513
　End If
Next
Exit Sub
ErrHandler:
If Err.Number = 513 Then
　sh.Activate
　If MsgBox(sh.Name & "フィルタを解除しますか？", vbOKCancel) = vbOK Then
　 sh.AutoFilter.Range.AutoFilter
　Else
　 Cancel = True
　 MsgBox "フィルタを解除しないと保存できません。", vbExclamation
　 Exit Sub
　End If
　Resume Next
Else
　MsgBox Err() & ": " & Err.Description
End If
End Sub
'///

この回答へのお礼

こんばんは、
お忙しい中、回答頂きありがとうございます！

試したところ、結構イメージ通りにいけました！ Err.Raise 513なんて初めて見ました。意図してないものがあった場合、エラーを発生させる？？ってことなんでしょうか。
いつも、本当にありがとうございます。

お礼日時：2015/08/29 21:55