[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『シートの削除・移動等の禁止』（やま）
左端からシート名 "リスト" "送信票" が有ります。この２枚のみ削除・移動及び シート名の変更を禁止する方法をご伝授下さい。
"送信票" の会社名をシートに貼り付けたコンボボックスに、"リスト" のＡ列のデータ で取り込んでいます。コピー用としてマクロで "送信票" の会社名をシート名とした、 新シートを "送信票" の右隣りに挿入しています。
ブックの保護を行えば、すべてのシートに対して、 削除・移動及び シート名の変更が禁止できます。
この状態で左端から二つのシート以外なら、 これらの機能を可能にするようにＶＢＡで「削除・移動及び シート名の変更」をシュミレートする 方法が考えられます。まるっきりシュミレートする仕様だと結構大変です。 ユーザーに色んなことをさせることを想定すると、 Excel機能をVBAでシュミレートするのはどれも大変なのですが・・・。
「現在選択されているシートに対して、 あるボタンがクリックされたら、削除･移動･名前の変更 等の選択メニューを表示し、選択された項目により、シートに対して処理する」という仕様なら、 移動に関しては、もう少し仕様を考えなくてはなりませんが、削除と名前の変更なら、この後の処理は、 ブックの保護解除、選択された項目の処理実行、再度ブック保護 という処理となり、比較的簡単です。
というようにVBAで行う方法を検討してみてください。
特定のシート以外は シートタブ選択---右クリックで表示される機能全部可能にする という仕様なら、もうちょっとじっくり、仕様検討が必要かもしれませんが・・・。
ichinose
ichinose さん
返事が遅れて申し訳ありません。 「ブックの保護解除、選択された項目の処理実行、再度ブック保護」でやってみます。 移動に関しては安易な考えですが、ブックを開く時に左端からシート名 "リスト" ・ "送信票" に並ぶ様にと、考えています。
もっと本格的な方法をご教授頂ければ有難いです。
(やま)
例題コードとして、新規ブックにて試してください。 新規ブックには、Sheet1からSheet5までを作成してください。
Thisworkbookのモジュールにブックが開いたら、ブックの保護を行うコードです。
'===================================================================
Private Sub Workbook_Open()
On Error Resume Next
ThisWorkbook.Protect
On Error GoTo 0
End Sub
ユーザーフォーム（UserForm1）を作成してください。 コントロールは、説明の都合上コードで配置しますから、 何も配置しないください。
Userform1のモジュールに
'================================================================================
Option Explicit
Public shori As Long
'↑ 1 シート削除 2 シート名変更 3 シート移動 9 処理ナシ
Public reshtnm As String
' ↑ shoriが2のとき意味があり、変更シート名
Public mvidx As Long
' ↑ shoriが3のとき意味があり、このシートindexの後に移動する
Private stidx As Long
Private WithEvents optshdel As MSForms.OptionButton
Private WithEvents optshrnm As MSForms.OptionButton
Private WithEvents optshmv As MSForms.OptionButton
Private lstshnm As MSForms.ListBox
Private WithEvents spn_up_dwn As MSForms.SpinButton
Private lblsht As MSForms.Label
Private txtsht As MSForms.TextBox
Private WithEvents btn_ok As MSForms.CommandButton
Private WithEvents btn_ng As MSForms.CommandButton
'================================================================================
Private Sub btn_ng_Click()
shori = 9
Me.Hide
End Sub
'================================================================================
Private Sub btn_ok_Click()
If shori = 2 Then
reshtnm = txtsht.Text
ElseIf shori = 3 Then
If lstshnm.ListIndex - stidx >= 0 Then
mvidx = lstshnm.ListIndex + 3
Else
mvidx = lstshnm.ListIndex + 2
End If
End If
Me.Hide
End Sub
'================================================================================
Private Sub optshdel_Click()
lblsht.Visible = False
txtsht.Visible = False
lstshnm.Visible = False
spn_up_dwn.Visible = False
shori = 1
End Sub
'================================================================================
Private Sub optshmv_Click()
lblsht.Visible = True
txtsht.Visible = False
lstshnm.Visible = True
spn_up_dwn.Visible = True
shori = 3
End Sub
'================================================================================
Private Sub optshrnm_Click()
lblsht.Visible = True
txtsht.Visible = True
lstshnm.Visible = False
spn_up_dwn.Visible = False
shori = 2
End Sub
'================================================================================
Private Sub spn_up_dwn_SpinDown()
Dim g0 As Long
With lstshnm
If .ListIndex < .ListCount - 1 Then
g0 = .ListIndex + 2
.AddItem .Value, g0
.RemoveItem .ListIndex
.ListIndex = g0 - 1
End If
End With
End Sub
'================================================================================
Private Sub spn_up_dwn_SpinUp()
Dim g0 As Long
With lstshnm
If .ListIndex > 0 Then
g0 = .ListIndex - 1
.AddItem .Value, g0
.RemoveItem .ListIndex
.ListIndex = g0
End If
End With
End Sub
'================================================================================
Private Sub UserForm_Activate()
If shori = 9 Then Me.Hide
End Sub
'================================================================================
Private Sub UserForm_Initialize()
Dim g0 As Long
shori = 0
If ActiveSheet.Index > 2 Then
With Me
.Caption = "シートの削除・名前の変更・移動"
.Width = 417
.Height = 309
With .Controls.Add("Forms.Frame.1", , True)
.TabStop = False
.Caption = "処理の選択"
.Left = 18
.Top = 18
.Width = 120
.Height = 108
.SpecialEffect = 2
Set optshdel = .Controls.Add("Forms.OptionButton.1", , True)
With optshdel
.Left = 24
.Top = 18
.Width = 77.5
.Height = 24
.Caption = "シートの削除"
End With
Set optshrnm = .Controls.Add("Forms.OptionButton.1", , True)
With optshrnm
.Left = 24
.Top = 42
.Width = 77.5
.Height = 24
.Caption = "シート名の変更"
End With
Set optshmv = .Controls.Add("Forms.OptionButton.1", , True)
With optshmv
.Left = 24
.Top = 66
.Width = 77.5
.Height = 24
.Caption = "シートの移動"
End With
End With
Set lblsht = .Controls.Add("Forms.Label.1", , False)
With lblsht
.Font.Size = 14
.Left = 150
.Top = 24
.Width = 60
.Height = 18
.BackColor = &HFFFFC0
.Caption = "シート名"
.SpecialEffect = 2
End With
Set txtsht = .Controls.Add("Forms.TextBox.1", , False)
With txtsht
.TabStop = False
.Font.Size = 14
.Left = 210
.Top = 24
.Width = 168
.Height = 18
.Font.Size = 12
End With
Set lstshnm = .Controls.Add("Forms.ListBox.1", , False)
With lstshnm
.TabStop = False
.Left = 150
.Top = 54
.Width = 228
.Height = 192
For g0 = 3 To ThisWorkbook.Worksheets.Count
.AddItem ThisWorkbook.Worksheets(g0).Name
Next
.ListIndex = ActiveSheet.Index - 3
stidx = .ListIndex
.Enabled = False
End With
Set spn_up_dwn = .Controls.Add("Forms.SpinButton.1", , False)
With spn_up_dwn
.TabStop = False
.Left = 378
.Top = 54
.Width = 24
.Height = 192
End With
Set btn_ok = .Controls.Add("Forms.CommandButton.1", , True)
With btn_ok
.TabStop = False
.Left = 18
.Top = 132
.Width = 54
.Height = 30
.Caption = "実行"
End With
Set btn_ng = .Controls.Add("Forms.CommandButton.1", , True)
With btn_ng
.TabStop = False
.Left = 78
.Top = 132
.Width = 54
.Height = 30
.Caption = "キャンセル"
End With
End With
Else
MsgBox "このシートの削除や移動は、禁止されています"
shori = 9
End If
End Sub
'================================================================================
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode <> 1 Then
Cancel = True
shori = 9
Me.Hide
End If
End Sub
'================================================================================
Sub term_proc()
Set optshdel = Nothing
Set optshrnm = Nothing
Set optshmv = Nothing
Set lstshnm = Nothing
Set spn_up_dwn = Nothing
Set lblsht = Nothing
Set txtsht = Nothing
Set btn_ok = Nothing
Set btn_ng = Nothing
End Sub
尚、UserForm_Initialize()のコード内でコントロールを配置していますが、実際には 殆どのことが事前設定で可能なことです。
標準モジュールに
'==========================================================================
Option Explicit
Sub Sht_proc()
With UserForm1
.Show
On Error Resume Next
Select Case .shori
Case 1
ThisWorkbook.Unprotect
ActiveSheet.Delete
ThisWorkbook.Protect
Case 2
ThisWorkbook.Unprotect
ActiveSheet.Name = .reshtnm
ThisWorkbook.Protect
Case 3
ThisWorkbook.Unprotect
ActiveSheet.Move After:=Worksheets(.mvidx)
ThisWorkbook.Protect
End Select
.term_proc
End With
Unload UserForm1
End Sub
これで 一度適当な場所に保存した後、一度当該ブックを閉じた後、再び、当該ブックを開いてください
Sheet1、Sheet2以外のシートをアクティブにして上記のSht_proc を実行してください。
ユーザーフォームが表示されます。 削除 名前の変更、移動という処理が選択できますから、選択して下さい。
削除を選択したら、そのまま実行ボタンを押してください、アクティブシートが削除されます。
名前の変更を選択すると、変更名が入力できますから、入力後、実行ボタンを押してください。 名前の変更を行います。
移動を選択すると、リストボックスにアクティブシートの現在の位置が表示されますから、スピンボタンで 移動先を調節してください。移動先が確定したら、実行ボタンを押してください。指定位置に移動します。
一例ですが、試してみてください。うまくいくようでしたら、適当なボタンにSht_procを登録すればよいです。
ichinose@2009/3/23朝訂正
ichinose さん
ご返答頂いてるのを今まで全く気づかず、大変申し訳ありません。 今、エクセルにコードを貼り付け実行しました。 自分が思っていた以上の事が出来感激しています。 コードの意味するところを、これから勉強させて頂きます。
有難うございました。
(やま)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.