プロが教えるわが家の防犯対策術!

QNo.3901563で回答いただき、Excelの試用で保護後のオートフィルタは使えないのはわかりました。
そこで予めオートフィルタを設定し、シートに保護をかけました。
Excelの画面上ではオートフィルタは使用できます。
マクロよりオートフィルタの抽出条件を変更するコマンドを実行すると「保護されたシートに対して、このコマンドは実行できません」と表示されます。コマンドは新しいマクロの記録で操作を記録したものです。記録したときは特にエラーはでませんでした。

Selection.AutoFilter Field:=2, Criteria1:="AAA"

マクロのコマンドでは保護のかかったシートのオートフィルタの抽出条件を変更することは出来ないのでしょうか。
マクロの前後にシート保護を解除するコマンドを入れようかとも思ったのですが、保護にパスワードがかかっており、本末転倒となるもので。

このQ&Aに関連する最新のQ&A

A 回答 (2件)

こんにちは。



'標準モジュールで、自動設定

Sub Auto_Open()
Const PWS As String = "PS" 'パスワード
 With Worksheets("Sheet2")
  .Unprotect PWS
  .Protect PWS, UserInterFaceOnly:=True
  '以下をつければ、手動でもオートフィルタは使えます。
  .EnableAutoFilter = True
 End With
End Sub

'-----------------------------------------------
UserInterFaceOnly:=True のオプションをつければ、マクロで処理できますし、また、EnableAutoFilter にすれば、保護された状態で、オートフィルタは使えます。

なお、オートフィルタは、こんな感じです。

Sub Test1()
With Range("A1").CurrentRegion
 .AutoFilter Field:=2, Criteria1:="aaa"
End With
End Sub
    • good
    • 0
この回答へのお礼

教えていただいた記述をブックを開くときに実行することでマクロが動くようになりました。
詳しく説明ありがとうございます。

お礼日時:2008/03/31 13:20

マクロでも保護の掛かったシートの状態を操作できません。



対策としては、マクロの最初で保護を解除し、実行後に保護を掛けます。
別の方法としては、ブック起動後に保護されたシートに対して「マクロは有効」という呪文(コード)を1回だけ実行する方法もあります。
    • good
    • 0
この回答へのお礼

ありがとうございました。

お礼日時:2008/03/31 13:15

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Q[Excel]保護されたシートのマクロによるオートフィルタ有効設定について

先日、こちらのカテゴリでお世話になった者です。

ご質問に関して、前記事の参照が必要となるため、以下に記載致します。

【参照元】http://okwave.jp/qa2538402.html

参照元のご回答を元に、無事商品管理のブックを完成させました。
その後、よく調べれば当たり前の事だったようなのですが、保護をかけると
オートフィルタが動作しない事が分かりました。

私なりに調べて、ブックが開かれるタイミングで.EnableAutoFilterの記述が
必要になる事がわかり、参照元ANo.2内の中を以下のようにしてみました。

Private Sub Workbook_Open()
  On Error Resume Next
  With ThisWorkbook
    .Unprotect Password:=BOOK_PASSKEY
    .EnableAutoFilter = True '追記した行です
    .IsAddin = False
    .Saved = True
  End With
  If mApp Is Nothing Then Set mApp = Application
  ' カスタムメニューをセルの右クリックに追加
  Call AddCustomMenu
End Sub

これではエラーが出て動かず、更に調べました所、Excel2003などの比較的
新しいバージョンでは、保護の際にオートフィルタの有効無効のチェックが
出来る事がわかりました。

私はExcel2000なので、そもそもが記述をしても仕様上、保護下でのオート
フィルタは無理なのでしょうか?

Workbook_Open()のすぐ下の行に記述すると、1度保護を解除してかけ直せば
保護下でもオートフィルタが動くのですが、保存して再度ブックを開くと
オートフィルタはまた無効になってしまいました。

今一歩と思うのですが、どうしてもうまく出来ません。
どのように追記をすればオートフィルタが可能になるでしょうか?
または、無理なのでしょうか。

よろしくご教授下さい。

先日、こちらのカテゴリでお世話になった者です。

ご質問に関して、前記事の参照が必要となるため、以下に記載致します。

【参照元】http://okwave.jp/qa2538402.html

参照元のご回答を元に、無事商品管理のブックを完成させました。
その後、よく調べれば当たり前の事だったようなのですが、保護をかけると
オートフィルタが動作しない事が分かりました。

私なりに調べて、ブックが開かれるタイミングで.EnableAutoFilterの記述が
必要になる事がわかり、参照元ANo.2内の中を以下のようにしてみま...続きを読む

Aベストアンサー

> 前回の記事で頂いたセットが、たくさんの機能を含んでおりまして

やり過ぎました...すみません。

よくよく考えれば、別にマクロ無効で開かれたところで問題なさそうです。
マクロの無効化対策はカットしましょう。

管理者用のシート一括保護・保護解除は自分の経験上、無いと非常に不便
なので残しておきますが、不要ならプロシージャごとカットして下さい。

メニュー追加コードがあるとどかーんとコードが長くなってしまうのですが、
最近のデジカメはやたらと大きな画像なので、段階的にでもサイズ指定して
画像を挿入できた方が便利だと思いす。で...これも残しておきますね。

前回はろくろくデバッグもしないし、開発用コードも残したままで投稿
してしまったので、細かな修正を何箇所かこっそり入れました。(´・ω・`)

全体を差し替えてみて下さい。長文ごめんなさい。

Option Explicit

' 設定 ------------------------------------------------------------------------
' シート保護のパスワードを設定(無しなら""とする)
Private Const PASSKEY = "123"
' 管理者パスワード(シートの一括保護・解除に使用します)
Private Const ADMIN_PASSKEY = "admin"
'------------------------------------------------------------------------------

Private WithEvents mApp As Application
Private mcMenu     As CommandBarControl

Private Sub Workbook_Open()
  Dim Sh As Worksheet
  On Error Resume Next
  If mApp Is Nothing Then Set mApp = Application
  Call AddCustomMenu
  ’以下の追加コードが今回のご質問の回答になるかと。
  Call SheetUnProtect
  For Each Sh In ThisWorkbook.Worksheets
    Sh.EnableAutoFilter = True
  Next
  Call SheetProtect
  ThisWorkbook.Saved = True
End Sub

' // このブック以外ではカスタムメニューを表示させない
Private Sub mApp_WindowActivate(ByVal Wb As Workbook, ByVal Wn As Window)
  On Error Resume Next
  If Not mcMenu Is Nothing Then
    If Wb Is ThisWorkbook Then
      mcMenu.Visible = True
    Else
      mcMenu.Visible = False
    End If
  End If
End Sub

' // 管理者メンテ用メニュー
Public Sub 管理者専用()
  Dim sPass   As String
  Dim iErrCount As Integer
  Dim iMode   As Variant
  On Error Resume Next
  Do While iErrCount < 3 ' 3 回までタイプミス OK
    sPass = InputBox("Caps キーや Numlock に注意して下さい", _
             "管理者パスワード")
    If sPass = ADMIN_PASSKEY Then
      iMode = InputBox("1: 全シート保護" & vbLf _
              & "2: 全シート保護解除", _
               "管理者メニュー")
      If Val(iMode) = 2 Then
        Call SheetUnProtect
        MsgBox "シート保護解除しました", vbInformation
      Else
        Call SheetProtect
        MsgBox "シート保護しました", vbInformation
      End If
      Exit Sub
    Else
      Call SheetProtect
      iErrCount = iErrCount + 1
    End If
  Loop
  MsgBox "認証に失敗しました", vbCritical
End Sub

' // マクロで画像を挿入
Private Sub InsertPic()
  Dim vFnames As Variant
  Dim vFname As Variant
  Dim sngZoom As Single
  Dim Pic   As Picture
  Dim sngW  As Single
  Dim sngH  As Single
  Dim iOffet As Integer
  On Error Resume Next
  vFnames = Application.GetOpenFilename( _
       FileFilter:="Image ファイル, *.jpg;*.bmp;*.gif;*.tif;*.png", _
       Title:="画像ファイルを指定して下さい", _
       MultiSelect:=True)
  If IsArray(vFnames) Then
    Application.ScreenUpdating = False
    With Selection
      sngW = .Width: sngH = .Height
    End With
    sngZoom = CSng(Application.CommandBars.ActionControl.Parameter)
    iOffet = 0
    For Each vFname In vFnames
      Set Pic = ActiveSheet.Pictures.Insert(vFname)
      With Pic
        .Placement = xlFreeFloating
        .Locked = False
      End With
      With Pic.ShapeRange
        .LockAspectRatio = msoTrue
        Select Case sngZoom
          Case 0: .Height = sngH
          Case 1: .Width = sngW
          Case 2: .LockAspectRatio = msoFalse
              .Width = sngW
              .Height = sngH
          Case 10 To 400 ' 10~400% を有効とする
              .Height = .Height * sngZoom / 100#
        End Select
        ' MultiSelect 時のオフセット
        .IncrementTop CSng(10 * iOffet)
        .IncrementLeft CSng(10 * iOffet)
        iOffet = iOffet + 1
      End With
      Set Pic = Nothing
    Next
  End If
End Sub

' // セルの右クリックメニューにカスタムメニューを追加
Private Sub AddCustomMenu()
  Dim Cmb   As CommandBar
  Dim sAction As String
  Set Cmb = Application.CommandBars("Cell")
  On Error Resume Next
  Cmb.Controls("画像の挿入(&D)").Delete
  Set mcMenu = Cmb.Controls.Add(Type:=msoControlPopup, Temporary:=True)
  With mcMenu
    .Caption = "画像の挿入(&D)"
    .BeginGroup = True
    sAction = ThisWorkbook.FullName & "!ThisWorkbook.InsertPic"
    With .Controls.Add(Type:=msoControlButton)
      .Caption = "選択範囲の縦を基準にする(&1)"
      .OnAction = sAction
      .Parameter = 0
    End With
    With .Controls.Add(Type:=msoControlButton)
      .Caption = "選択範囲の幅を基準にする(&2)"
      .OnAction = sAction
      .Parameter = 1
    End With
    With .Controls.Add(Type:=msoControlButton)
      .Caption = "選択範囲の縦横に合わせる(&3)"
      .OnAction = sAction
      .Parameter = 2
    End With
    With .Controls.Add(Type:=msoControlButton)
      .Caption = "100%(&4)"
      .OnAction = sAction
      .Parameter = 100
    End With
    With .Controls.Add(Type:=msoControlButton)
      .Caption = "75%縮小(&5)"
      .OnAction = sAction
      .Parameter = 75
    End With
    With .Controls.Add(Type:=msoControlButton)
      .Caption = "50%縮小(&6)"
      .OnAction = sAction
      .Parameter = 50
    End With
    With .Controls.Add(Type:=msoControlButton)
      .Caption = "25%縮小(&7)"
      .OnAction = sAction
      .Parameter = 25
    End With
  End With
  Set Cmb = Nothing
  If mApp Is Nothing Then Set mApp = Application
  On Error GoTo 0
End Sub

' // シートに対しパス付き保護をかけます
Private Sub SheetProtect(Optional ByRef Wst As Worksheet)
  ' 引数:[Wst] シートオブジェクト。省略するとブック内の全シート
  Dim Sh As Worksheet
  On Error Resume Next
  If Not Wst Is Nothing Then
      Wst.Protect Password:=PASSKEY, _
            UserInterfaceOnly:=True, _
            DrawingObjects:=False
  Else
    For Each Sh In ThisWorkbook.Worksheets
      Sh.Protect Password:=PASSKEY, _
            UserInterfaceOnly:=True, _
            DrawingObjects:=False
    Next
  End If
End Sub
' // シートの保護を解除します
Private Sub SheetUnProtect(Optional ByRef Wst As Worksheet)
  ' 引数:[Wst] シートオブジェクト。省略するとブック内の全シート
  Dim Sh As Worksheet
  On Error Resume Next
  If Not Wst Is Nothing Then
      Wst.Unprotect Password:=PASSKEY
  Else
    For Each Sh In ThisWorkbook.Worksheets
      Sh.Unprotect Password:=PASSKEY
    Next
  End If
End Sub

> 前回の記事で頂いたセットが、たくさんの機能を含んでおりまして

やり過ぎました...すみません。

よくよく考えれば、別にマクロ無効で開かれたところで問題なさそうです。
マクロの無効化対策はカットしましょう。

管理者用のシート一括保護・保護解除は自分の経験上、無いと非常に不便
なので残しておきますが、不要ならプロシージャごとカットして下さい。

メニュー追加コードがあるとどかーんとコードが長くなってしまうのですが、
最近のデジカメはやたらと大きな画像なので、段階的にでもサ...続きを読む

QエクセルVBA 保護シート&フィルタ実行 全シート

VBA超初心者です。

たくさんのシートのあるエクセルで、
シート保護後もフィルタを使用できるようにVBAを設定したいと思ってます。
(現在エクセル2000を使用してます)

ネットで調べてVBAを設定してみました。
しかし下記のようにするとコンパイルエラーになってしまうのですが、
正しい方法を教えていただけると助かります。

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Application.CommandBars("Cell").Reset
End Sub

Private Sub Workbook_Open()
  With Application.CommandBars("Cell").Controls.Add( _
           Type:=msoControlButton, Before:=1, Temporary:=True)
    .Caption = "AutoFilter"
    .OnAction = "ThisWorkbook.filter"
  End With
  With Worksheets.Select
    .Unprotect
    .EnableAutoFilter = True
    .Protect UserInterfaceOnly:=True
  End With
End Sub

Private Sub filter()
  On Error Resume Next
  Selection.AutoFilter
End Sub

VBA超初心者です。

たくさんのシートのあるエクセルで、
シート保護後もフィルタを使用できるようにVBAを設定したいと思ってます。
(現在エクセル2000を使用してます)

ネットで調べてVBAを設定してみました。
しかし下記のようにするとコンパイルエラーになってしまうのですが、
正しい方法を教えていただけると助かります。

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Application.CommandBars("Cell").Reset
End Sub

Private Sub Workbook_Open()
  With Applicatio...続きを読む

Aベストアンサー

変更前:
 With Worksheets.Select
  .Unprotect
  .EnableAutoFilter = True
  .Protect UserInterfaceOnly:=True
 End With

変更後:
 dim h as worksheet
  :
 For Each h In Worksheets
 With h
  .Protect UserInterfaceOnly:=True
  .EnableAutoFilter = True
 End With
 Next


人気Q&Aランキング