[[20130527202751]]　『再び追加でおねがいします』（ちぃさん）　ページの最後に飛ぶ

『再び追加でおねがいします』（ちぃさん）

度々同じことですみません。
[[20130524235349]]　での追加質問です。
ご教示いただいたマクロコードは完璧すぎるものでしたが
シートの保護がかかっていればご教示いただいたマクロは無効になるのでしょうか？
数量入力をする部分への入力とフィルターは許可されていまして、その他は保護のかかっている事に今日、使う際に気づきました。

エラー内容
「実行エラー`1004`;

 WorksheetクラスのShowAllDataメソットが失敗しました。」

やはり保護がかけられていれば諦めないとダメでしょうか？
何かいい手立てがありましたら教えていただきたいです。
どうぞ宜しくお願いします。

WindowsXP、Excel2003　と　Windows 7、Excel2010で対応できるものが希望です

 参考コードを３種類。

 Sub Test1()
    Dim i As Long
    If ActiveSheet.AutoFilterMode Then
        For i = 1 To ActiveSheet.AutoFilter.Filters.Count
            If ActiveSheet.AutoFilter.Filters(i).On Then
                ActiveSheet.AutoFilter.Range.AutoFilter Field:=i
            End If
        Next
    End If
 End Sub

 Sub Test2()
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True, UserInterfaceOnly:=True
    ActiveSheet.ShowAllData
 End Sub

 Sub Test3()
    ActiveSheet.Unprotect
    ActiveSheet.ShowAllData
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
 End Sub

 追記）

 >WindowsXP、Excel2003　と　Windows 7、Excel2010で対応できるものが希望です

 これをわすれていた。今回の件とは別件だけど、FilterMode　は 2007で追加された新しいプロパティなので
 2003 では使えないはず。双方で使うなら、少し異なるコードにする必要がある。

 If ActiveSheet.FilterMode Then を

 If ActiveSheet.AutoFilter.Range.Rows.Count <> ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count Then

 こうすれば、両方で使えるかな？
 (ぶらっと)

 ↑　Test2,Test3 の Protectメソッドでは、操作者に許可する条件を規定の条件にオートフィルター利用を加えただけなので
 　　もし、そのほかにも、特別にシート保護時にチェックしたものがあれば、それらについても記述が必要。

 (ぶらっと)

 追記というか念のため。

 アップしたコードは参考部品なので、これらを既存のプロシジャに組み込む場合は
 ActiveSheet を sh に変更して使ったほうがいいね。

 (ぶらっと)

 (ぶらっと)サン　回答ありがとうございます。
ご教示いただいているのに返事が遅れまして大変申し訳ないです。

重ね重ね申し訳ないのですが未熟な私には
＞参考コードを３種類。
恥ずかしながらコチラのコードが使いこなし方が解らないです。
シートコピーした後コピー先のフィルタリング状態を解除させるにはどう組めばいいでしょうか？

何卒宜しくお願いいたします。

 Workbook_SheetActivate のコードは以下のようなものだったね。

 'コピー先のシートのフィルター状況を解除するなら
 Private Sub Workbook_SheetActivate(ByVal sh As Object)
    'シートが１枚増えていれば
    If Worksheets.Count = totPages + 1 Then
        If sh.AutoFilterMode Then   'オートフィルター設定あり
            'もしフィルタリングがかかたままならフィルタリングを解除
            If sh.FilterMode Then sh.ShowAllData                        '★★
        End If
    End If
    totPages = Worksheets.Count     '最新のシート数に置き換え
 End Sub

 この中の　★★　をつけた１行が、今回、シート保護下で、問題になるところだよね。
 で、この１行に対して、それを回避するための参考コードを３つと、もう１つ、FilterMode　が 2007以降じゃないと使えないので
 2003 でも使うならということで、代替コードを連絡したんだけど、それらを加味して、★★の１行だけを、３種類の記述にかえてみると
 以下のようになる。

        For i = 1 To sh.AutoFilter.Filters.Count
            If sh.AutoFilter.Filters(i).On Then
                sh.AutoFilter.Range.AutoFilter Field:=i
            End If
        Next

 あるいは

    If sh.AutoFilter.Range.Rows.Count <> sh.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count Then
        sh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
            , AllowFiltering:=True, UserInterfaceOnly:=True
        sh.ShowAllData
    End If

 あるいは

    If sh.AutoFilter.Range.Rows.Count <> sh.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count Then
        sh.Unprotect
        sh.ShowAllData
        sh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
            , AllowFiltering:=True
    End If

 なお、最初のパターンは変数 i を使うので、
 Private Sub Workbook_SheetActivate(ByVal sh As Object)
 この下に
 Dim i As Long を追加記述してね。

 (ぶらっと)

おはようがざいます。
(ぶらっと)サン　回答ありがとうございます。

エラーとなっていました部分を新たにご教示いただきましたコードに変え試してみました。
私の扱いが悪いためまたエラーがでました。
エラー内容は

「実行エラー`104`;

 保護されたシートに対して、このコマンドは使用できません。このコマンドを使用するに
　は、まずシートの保護を解除してください（[校閲]タブの[変更]グループにある[シート
　保護の解除]をクリックします）。パスワードの入力を要求されることもあります。」

と出ました。
飲み込みが悪く申し訳ないです。
新たにご教示いただきました内容でコチラで変更ました状態をアップいたします。
間違っている所がありましたらお叱りください。
Private Sub Workbook_SheetActivate(ByVal sh As Object)以降の記述をアップいたします。

1パターン目:
Private Sub Workbook_SheetActivate(ByVal sh As Object)

 Dim i As Long
    'シートが１枚増えていれば
    If Worksheets.Count = totPages + 1 Then
        If sh.AutoFilterMode Then   'オートフィルター設定あり
            'もしフィルタリングがかかたままならフィルタリングを解除
            If sh.AutoFilterMode Then
        For i = 1 To sh.AutoFilter.Filters.Count
            If sh.AutoFilter.Filters(i).On Then
                sh.AutoFilter.Range.AutoFilter Field:=i
            End If
        Next
     End If

        End If
    End If
    totPages = Worksheets.Count     '最新のシート数に置き換え
 End Sub

2パターン目:

Private Sub Workbook_SheetActivate(ByVal sh As Object)

    'シートが１枚増えていれば
    If Worksheets.Count = totPages + 1 Then
        If sh.AutoFilterMode Then   'オートフィルター設定あり
            'もしフィルタリングがかかたままならフィルタリングを解除
            If sh.AutoFilter.Range.Rows.Count <> sh.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count Then
        sh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
            , AllowFiltering:=True, UserInterfaceOnly:=True
        sh.ShowAllData
    End If

        End If
    End If
    totPages = Worksheets.Count     '最新のシート数に置き換え
 End Sub

3パターン目:

Private Sub Workbook_SheetActivate(ByVal sh As Object)

    'シートが１枚増えていれば
    If Worksheets.Count = totPages + 1 Then
        If sh.AutoFilterMode Then   'オートフィルター設定あり
            'もしフィルタリングがかかたままならフィルタリングを解除
            If sh.AutoFilter.Range.Rows.Count <> sh.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count Then
        sh.Unprotect
        sh.ShowAllData
        sh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
            , AllowFiltering:=True
    End If

        End If
    End If
    totPages = Worksheets.Count     '最新のシート数に置き換え
 End Sub

このように記述し試してみました。
同じことで何度も質問いたしまして申し訳ありませんが間違っている部分をご指導くださればと思います。
どうぞ宜しくお願いいたします。

↑
（ちぃさん）

連続投稿申し訳ないです。
上記の

＞実行エラー`104`;
は
実行エラー`1004`;
の間違いです。
すみません。

（ちぃさん）

 ３つのパターン、いずれも同じ 1004 エラー　ということ？

 (ぶらっと)

 今、そちらがアップしてくれた３つのパターン、それぞれを、念のため動かしてみたけど
 いずれも、問題なく、コピー先シートのフィルターが解除される。

 不思議だねぇ・・・

 もちろん、

 Dim totPages As Long

 Private Sub Workbook_Open()
    totPages = Worksheets.Count
 End Sub

 ここは、そのまま、残っているんだよね？

 追記）　ごめん、ごめん！！
 　　　　シート保護を掛けないで確認していた。
 　　　　あらためて対応コードをアップするので、しばしお待ちくださいな。

 (ぶらっと)

 (ぶらっと)

 お騒がせ。

 まず、最初のパターンは、無理みたい。ごめんね。
 で、２番目のパターン、３番目のパターン。コードの順序を少し変更。

 Private Sub Workbook_SheetActivate(ByVal sh As Object)

    シートが1枚増えていれば
    If Worksheets.Count = totPages + 1 Then
        If sh.AutoFilterMode Then   'オートフィルター設定あり
            もしフィルタリングがかかたままならフィルタリングを解除
            sh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
                , AllowFiltering:=True, UserInterfaceOnly:=True
            If sh.AutoFilter.Range.Rows.Count <> sh.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count Then
                sh.ShowAllData
            End If
        End If
    End If

    totPages = Worksheets.Count     '最新のシート数に置き換え

 End Sub

 または

 Private Sub Workbook_SheetActivate(ByVal sh As Object)

    'シートが１枚増えていれば
    If Worksheets.Count = totPages + 1 Then

        If sh.AutoFilterMode Then   'オートフィルター設定あり
            'もしフィルタリングがかかたままならフィルタリングを解除
            sh.Unprotect
            If sh.AutoFilter.Range.Rows.Count <> sh.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count Then
                sh.ShowAllData
            End If
            sh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
        End If
    End If

    totPages = Worksheets.Count     '最新のシート数に置き換え

 End Sub

 (ぶらっと)

(ぶらっと)サン　回答ありがとうございます。

＞ここは、そのまま、残っているんだよね？
残してますよ。

何度も色々な手を考えて頂きありがとうございます。
早速新たにご教示いただいたコード試させていただきました。

パターン1:

Private Sub Workbook_SheetActivate(ByVal sh As Object)

    シートが1枚増えていれば
    If Worksheets.Count = totPages + 1 Then
        If sh.AutoFilterMode Then   'オートフィルター設定あり
            もしフィルタリングがかかたままならフィルタリングを解除
            sh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
                , AllowFiltering:=True, UserInterfaceOnly:=True
            If sh.AutoFilter.Range.Rows.Count <> sh.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count Then
                sh.ShowAllData
            End If
        End If
    End If

    totPages = Worksheets.Count     '最新のシート数に置き換え

 End Sub

コチラのコードはエラーがでました。
エラー内容は

「コンパイルエラー：
　SubまたはFunctionが定義されていまさん。」

と表示されました。

パターン2：

 Private Sub Workbook_SheetActivate(ByVal sh As Object)

    'シートが１枚増えていれば
    If Worksheets.Count = totPages + 1 Then

        If sh.AutoFilterMode Then   'オートフィルター設定あり
            'もしフィルタリングがかかたままならフィルタリングを解除
            sh.Unprotect
            If sh.AutoFilter.Range.Rows.Count <> sh.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count Then
                sh.ShowAllData
            End If
            sh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
        End If
    End If

    totPages = Worksheets.Count     '最新のシート数に置き換え

 End Sub

コチラのコードはシートをコピー移動後にパスワードを求める表示がでました。
パスワードを未入力のまま　「キャンセル」をクリック後にエラーがでます。
エラー内容は

「実行エラー`1004`;

 保護されたシートに対して、このコマンドは使用できません。このコマンドを使用するに
　は、まずシートの保護を解除してください（[校閲]タブの[変更]グループにある[シート
　保護の解除]をクリックします）。パスワードの入力を要求されることもあります。」

と表示されました。
(ぶらっと)サン　沢山考えていただいて本当に感謝しております。
もしまだ手立てがあるようでしたらお願いしたいです。

本当になんどもすみません。

 まずパターン1　の

 >「コンパイルエラー： 　SubまたはFunctionが定義されていまさん。」

 これは、わかりやすいね。
 コンパイルをしてみると、シャドーがついてエラーになるコードは

    シートが1枚増えていれば

 ここだったでしょ？　パターン２では、それがでない。
 どこか違うね？　パタン２では、この行がコメントになっているけど、パターン１ではコメントになっていないので
 【シートが1枚増えていれば】という名前のプロシジャだとみなされている。

 （パターン１には、もう一か所、そういうところもあるね）

 ↑　追記 2013/5/30 23:45
 　　コメントにしないでアップしたのは、ぶらっと　だったんだね。失礼しました！！！

 >パスワードを求める表示がでました

 もし、このシートの保護をパスワードつきにしているなら、 Protect も UnProtect も　そのパスワードを指定する必要がある。

            sh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
                , AllowFiltering:=True, UserInterfaceOnly:=True, Password:="abcdefg"

 とか

            sh.Unprotect Password:="abcdefg"

 とか

            sh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True,Password:="abcdefg"

 パスワード文字列は実際のものに。

 (ぶらっと)

おはようございます。

 (ぶらっと)サン　回答ありがとうございます。

 (ぶらっと)サン　から新たにご教示していただいたコードを試して気づきました。
私の説明不足な部分がありました。

＞やはり保護がかけられていれば諦めないとダメでしょうか？
この部分をもっと具体的に説明するべきでした。

今、フイルターのかかっているシートをコピー移動した際にフイルターを解除させたいシートは私が作ったものではございませんのでパスワードがわからないのです。

沢山の時間を私のためにつかって頂いたのに説明不足な部分があり本当に申し訳ありません。
今、もの凄く不可能な気がしてきているのですが、パスワードが解らなければ強制的に解除は無理？でしょうか？やはり？

 >パスワードが解らなければ強制的に解除は無理？でしょうか？やはり？

 はい。だめですね。
 世の中には、パスワードを打ち破るソフトもたくさん出回っているので、やろうとしたら、できるはず。
 でも、やっちゃいけない。やれば、それは【犯罪】

 作成者に事情を話して、パスワードを教えてもらうしかないね。

 (ぶらっと)

(ぶらっと)サン　回答ありがとうございます。

＞でも、やっちゃいけない。
ですよね。
大変失礼いたしました。

＞作成者に事情を話して、パスワードを教えてもらうしかないね。
そのようにいたします。

でも私の質問にお答えいただき助かりました。
未熟な私にはまだまだ十分すぎる内容の説明と回答でありました。

長々とお付き合いいただき感謝しております。
また解らない事、解決したい事ができたときは質問にきたいのでその際はまたお願いしたいです。
ありがとうございました。

（ちぃさん）

コメント返信：

[ 一覧(最新更新順) ]

[[20130527202751]] 『再び追加でおねがいします』（ちぃさん） ページの最後に飛ぶ

[[20130527202751]]　『再び追加でおねがいします』（ちぃさん）　ページの最後に飛ぶ