シート保護を掛けたまま並べ替えやオートフィルタをするには

ThisWorkbookにWorkbook openでsheet保護を掛けています。
シート保護を掛けたまま並べ替えやオートフィルタをするにはどうしたらいいでしょうか。
ActiveSheet.Protect Password:="pass", AllowDeletingRows:=True, userInterfaceOnly:=True
Excel2003です回答御願いします。

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

• 失礼しました。「userInterfaceOnly:=True 'こちらはチェックしていません」こちらまで入れてしまっていました。それは除いたのですが昇順、降順のボタンは白く押せない状態です。

  No.1の回答に寄せられた補足コメントです。 補足日時：2018/11/19 21:47

No.4 ベストアンサー 回答者： WindFaller 回答日時： 2018/11/24 02:10

コードをみてどのようにしたいのか分かりました。

これは、並べ替えしたい列にマウスカーソルを置いて、
マクロ（ボタンで良い）を実行してみてください。

'//
Sub SortProgram1A()
　Dim num As Integer
　num = ActiveCell.Column
　If ActiveSheet.AutoFilterMode = False Then
　　MsgBox "オートフィルターがありません。", vbCritical
　　Exit Sub
　End If
　With ActiveSheet.AutoFilter.Range
　　If num > .Columns.Count Then Exit Sub
　　.Sort Key1:=.Cells(1, num), _
　　　Order1:=xlAscending, _
　　　Header:=xlYes
　End With
End Sub
'//

'ActiveSheet.AutoFilterMode は、AutoFilter が設置させていないと実行に移さないようにしています。
'ActiveSheet.AutoFilter.Range これは、オートフィルター上の範囲の意味です。
.Cells(1, num), 　これは、任意の列のオートフィルターの範囲のヘッダー位置を示しています。

---------参考コード--------------------------
シフトキーを押したまま実行すると、降順になります。
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Const VK_SHIFT = &H10 'この上2つは、モジュールのてっぺんに置く

Sub SortProgram1Ar()
　Dim num As Integer
　Dim ad As Integer
　num = ActiveCell.Column
　If ActiveSheet.AutoFilterMode = False Then
　　MsgBox "オートフィルターがありません。", vbCritical
　　Exit Sub
　End If
　If GetKeyState(VK_SHIFT) < 0 Then
　　ad = xlDescending　　'シフトキーを押したら、降順に変わる
　Else
　　ad = xlAscending
　End If
　With ActiveSheet.AutoFilter.Range
　　If num > .Columns.Count Then Exit Sub
　　.Sort Key1:=.Cells(1, num), _
　　　Order1:=ad, _
　　　Header:=xlYes
　End With
End Sub

この回答へのお礼

回答有難う御座います。
選択したセルの項目の並べ替え出来るようになりました。
みんなに使ってもらう為降順のボタンも作ろうと思います。

お礼日時：2018/11/24 23:33

No.3 回答者： WindFaller 回答日時： 2018/11/22 20:38

>並べ替えが簡単に出来ないようですので選択したセル列の昇順と降順ボタンを作ってマクロを割り当てるのがいいのでしょうか。

私には、それしか思いつかなかったのです。
逆に、他に何か思いつくことはありませんか？例えば、右クリックメニューに入れるとか。

わざわざ、セルのロック自体を外すよりは良いかと思います。
私自身は、それをどのぐらい、見栄えがよく作れるか、ということを考えてしまいます。
それで、非常に小さいボタン（セルの半分ぐらい）は、フォームコントロール側のほうがよいようです。ActiveX コントールですと、1つのボタンでいろいろ違った動きを示すことが出来ますが、小さい場所に納まりません。

フォームコントロールのボタンひとつで、コントロールキーを押したままとかで、別のマクロを実行できる方法もあります。ただ、ちょっと難しい内容になってしまいます。

この回答へのお礼

回答有難う御座います。
範囲をCurrentRegionとしアクティブセルを基準に並べ替えをしようと思い以下のように書いてみましたがうまく動きませんでした？

Sub 並べ替え()
Dim c As Range
Set c = ActiveCell
Debug.Print (c.Value)

Range("A5").CurrentRegion.Sort　'A5を基に範囲選択ですがA5が文字化けしています'
Key1:=c, _
Order1:=xlAscending, _
Header:=xlYes
End Sub

お礼日時：2018/11/23 22:56

No.2 回答者： WindFaller 回答日時： 2018/11/19 22:45

こんばんは。

>こちらはチェックしていません」こちらまで入れてしまっていました。
たいへん失礼しました。

ところで、昇順降順の並び替えは別ですね。こちらも気が付かなかったのですが、あくまでも、オートフィルターだけでした。

以下のように、Protectに、
AllowSorting:=True を加えてあげればよいようですが、それではダメなのです。

ここで、オートフィルター範囲のロックを解除してあげないといけないのです。

Range("A1:E11").Locked =False '←例えばの範囲ですが、これが必要になってしまうのです。
ActiveSheet.EnableAutoFilter = True
ActiveSheet.Protect Password:="", _
　　 AllowDeletingRows:=True, _
　　 AllowSorting:=True, _
　　 userInterfaceOnly:=True

これで良ければ、お終いですが、
ちょっと、ロックを外したら意味がありません、となるのではないかと思います。

いっそ、 AllowSorting:=True, _ をやめて、
マクロで処理してしまったほうがよいかもしれませんね。
マクロなら、userInterfaceOnlyで、うごかせます。

内容は以下のような簡単な対話形式ですが。（もっとさり気なくできればよいのですが、もしくは、ヘッダーの部分のロックを外して、そこにイベントを設ける方法もありますね。）考えていくと思った以上に難しいです。

Sub Button_Click1()
Dim num As Integer
num = Application.InputBox("何列目を並べ替えますか？")
If num <= 0 Then Exit Sub 'キャンセルボタンでも、0になります。
With Range("A1").CurrentRegion
If num > .Columns.Count Then Exit Sub '範囲の列数を越えたら、マクロの離脱
.Sort Key1:=.Cells(1, num), Header:=xlYes　　'デフォルトで昇順になっています。
End With
End Sub

この回答へのお礼

回答有難う御座います。
並べ替えが簡単に出来ないようですので選択したセル列の昇順と降順ボタンを作ってマクロを割り当てるのがいいのでしょうか。

お礼日時：2018/11/22 00:08

No.1 回答者： WindFaller 回答日時： 2018/11/18 23:53

こうすればよいはずです。

ActiveSheet.EnableAutoFilter = True
ActiveSheet.Protect Password:="pass", AllowDeletingRows:=True, userInterfaceOnly:=True , userInterfaceOnly:=True 'こちらはチェックしていません。

この回答へのお礼

回答有難う御座います。
試させていただきましたところ「実行時エラー'448':　名前付き引数が見つかりません。」となってしまいました。

お礼日時：2018/11/19 21:29