- 締切済み
VBAで、貼り付け禁止命令を実現したい(エクセル)
お世話になります。 会社で、チーム員全体で、共有し、編集している、エクセルファイルがあるのですが、年配の方が、エクセルを使いこなすのが、今のところ難しく、どこへでも、関係のないデータを、貼り付け、保存してしまい、 それ以前に、正しく、表に入力をした人のデータはかき消されてしまったりしています。そこで、なんでもかんでも貼り付けをする癖を正すため、その表内は、貼り付け禁止にできないかと思いまして、質問しました。私は、VBAの基礎は解るので、色々と調べてみたのですが、貼り付け禁止にするという、やり方は探し出せませんでした。 お忙しいところ、すみませんが、思いつく方、アイディアを頂けませんでしょうか? 何卒、宜しくお願い致します。
- みんなの回答 (8)
- 専門家の回答
みんなの回答
- Wendy02
- ベストアンサー率57% (3570/6232)
こんにちは。 貼り付け禁止には、二つの方法があります。ひとつは、貼り付けキー自体を、Enable=False にすることです。どちらか好きなほうを一つ使うと良いと思います。 最初だけ、Auto_Open を実行すれば、後は、開いたときに設定されます。 解除の仕方は、お分かりになると思いますが、 'Enable の復活 Enable =True にすればよいです。 'クラス側の設定の解除 Erase ClassBtns 'ショートカットキー解除 Application.OnKey "^v", "" を使えばよいでしょう。 '------------------------------------- '標準モジュール Sub Auto_Open() Call DisEnableKeys End Sub Sub DisEnableKeys() Dim eFlg As Boolean eFlg = False 'サブルーチンにしてトグルも可能 With Application .CommandBars("Worksheet Menu Bar").Controls("編集(&E)").Controls("貼り付け(&P)").Enabled = eFlg .CommandBars("Cell").FindControl(, 22).Enabled = eFlg If eFlg = False Then .OnKey "^v", "DummyMacro" Else .OnKey "^v" End If End With End Sub Sub DummyMacro() MsgBox "貼り付けは禁止されています。", vbInformation End Sub '================================================= もう一つの方法は、貼り付けのすべてのキーをインスタンスでつぶしてしまえばよいと思います。上とは一緒に使わないほうがよいでしょう。 '標準モジュール Private ClassBtns(1) As New Class1 Public Pastechk As Boolean Sub Auto_Open() Call NewBtnSetting End Sub Sub NewBtnSetting() With Application Set ClassBtns(0).myNewBtn = .CommandBars("Worksheet Menu Bar").Controls("編集(&E)").Controls("貼り付け(&P)") Set ClassBtns(1).myNewBtn = .CommandBars("Cell").FindControl(, 22) Application.OnKey "^v", "DummyMacro" End With End Sub Sub DummyMacro() MsgBox "貼り付けは禁止されています。", vbInformation End Sub '---------------------------------------- 'Class1モジュール Private WithEvents NewBtn As Office.CommandBarButton Public Property Set myNewBtn(ByVal myBtn As CommandBarButton) Set NewBtn = myBtn End Property Private Sub NewBtn_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean) '二重呼び出しの禁止 If Pastechk = False Then MsgBox "貼り付けは禁止されています。", vbInformation Pastechk = True Else Pastechk = False End If CancelDefault = True End Sub
- taocat
- ベストアンサー率61% (191/310)
No6,ですが、色々アイデアを考えることは頭の体操になって面白いな、ということでもう一案。 最初の質問の意図に戻って考えてみると、 問題はその年配の人にあるわけですから、その人だけコピペ禁止で入力のみさせ、他の人には普通に作業してもらう方がいいような気がします。 既出のアイデアを利用。 具体的にはブックを開く時その年配の人とその他の人で別々のパスワードを入力させ、それにより別々の画面を表示させる 年配の人には、メニューバー、ツールバー、右クリックのメニュー非表示でかつ、Ctrl+C,V禁止 その他の人には、通常の画面。 これらをWorkBook Openイベントでして、年配の画面はBeforSaveやBeforCloseイベントなど適当なイベントで通常の画面に戻しておく。 先の投稿で言い忘れましたので、一言。 Merlion師匠のアイデアは、Good Job!! だと思います。。(^o^)/^
- taocat
- ベストアンサー率61% (191/310)
こんばんは。 NO4の回答のお礼のコードは、コピペだけでなく入力についても いちいち確認することになっていますが、 それって「問題の年配の方」にはいいのかも知れませんが、 普通に入力できる人には非常に煩わしいと思いますが、如何でしょう。 で、上記も勘案して以下のようにしてはどうでしょう。 (1)セルひとつへの入力は、ふつうに入力できるようにする(確認メッセージなし) (2)セルひとつのコピペは、メッセージで確認する (3)複数セルの処理は、入力もコピペも無条件にダメとし、その由メッセージを表示する (4)行の挿入は1行でも複数行でも可能とする どのシートでも上記動作になるようコードは、ThisWorkBookモジュールに。 '--------------- Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim Ans As Integer If Target.Count = 1 Then If Application.CutCopyMode Then Ans = MsgBox("貼り付けたデータは正しいですか?", vbYesNo, "確認") If Ans = vbNo Then MsgBox "正しいデータを貼り付けて下さいな" With Application .EnableEvents = False .Undo .EnableEvents = True End With End If Application.CutCopyMode = False End If End If End Sub '--------------- Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Target.Count = 1 Then Exit Sub If Target.Columns.Count = 256 Then Exit Sub MsgBox "複数セルはいやよ!", vbCritical, "確認" Target.Cells(1).Select Application.CutCopyMode = False End Sub '--------------- 複数セルに対しては上記コードのように、貼り付ける前、又は、入力する前の、セル範囲を選択した時点で判断した方がいいですよね。 先ず、新しいブックで上記コードをお試しください。
- merlionXX
- ベストアンサー率48% (1930/4007)
> 行挿入だけは、させて欲しいと言われました。 merlionXXです。 では、あらたにダブルクリックイベントを利用しましょうか。 下記のコードを追加しで、行を挿入したい箇所でダブルクリックしてみてください。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Cancel = True On Error GoTo line Application.EnableEvents = False Target.Insert Shift:=xlDown line: Application.EnableEvents = True End Sub
- merlionXX
- ベストアンサー率48% (1930/4007)
> 実際的に、コードを書けなかったのですが、 #1です。 標準モジュールではなく該当のシートのモジュールに以下をコピペしてください。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count = 1 Then Exit Sub Else MsgBox "複数セルを同時に変更しないでねん。!" With Application .EnableEvents = False .Undo .EnableEvents = True End With End If End Sub
- onlyrom
- ベストアンサー率59% (228/384)
再度のこんにちは。 >Ctrl+C,V が動作しないようにしておく、という方法 簡単には標準モジュールにプロシージャーを2つ置いて、 それに、Ctrl+CとVのショートカットキーを割り当てるだけです。 例えば、標準モジュールに以下があるとして。 --------------- Ctrl+C を割り当て---------- Sub Ctrl_C() MsgBox "Ctrl+C は使わんでね" End Sub --------------- Ctrl+V を割り当て---------- Sub Ctrl_V() MsgBox "Ctrl+V は使わんでね" End Sub ---------------------------------------------- 以上です。
お礼
早々にお返事有難うございましたm(__)m フカブカ 簡潔で、とても解り易い回答で、感激しました。 大変、助かりました。 これで、等チームの、深刻な悩みも、かなり楽になるはずです!! 深謝、深謝
- onlyrom
- ベストアンサー率59% (228/384)
こんにちは。 >関係のないデータを、貼り付け、保存してしまい 年配にしろそうでないにしろ正しいデータの上に関係ないデータを貼り付けたりするのは、エクセルの使い方というより、仕事そのものを理解していないからではありませんか。 「コピー&ペースト禁止!!」と言えば済む問題だと思いますが。 ま、それはそれとして、一案。 【入力のみ】のことであれば、そしてVBAを使いこなせるということなので ●メニューバー、ツールバーを全て消す ●右クリックも使えなくする ●Ctrl+C,Vが動作しないようにしておく なんて方法もありかも知れません。 以上です。
お礼
早々に、アドヴァイス有難うございました。 早速、メニューバーが出ないようにしてみたり、右クリックができないようにしてみたりしました。 癖を直す、強制ギブスのように、しばらくこれで活用しようかと思っています。 後、一つの、Ctrl+C,V が動作しないようにしておく、という方法 が解りません。もし、御存知でしたら、教えてください。
- merlionXX
- ベストアンサー率48% (1930/4007)
入力はOKで貼り付けはダメなら、ChangeEventでセル1個ならOK、複数セルならペケってのはどうでしょう?
補足
アドヴァイス、有難うございました。 この方法も有効そうですね。 私のレベルが低いので、実際的に、コードを書けなかったのですが、 また勉強してみますね。 有難うございました。
お礼
お世話になっておりますm(__)m 本当に有難うございました!! 教えて頂いた、ソースを参考に、下記のソースにアレンジし、 チームに配布したところ、使用者(ご本人以外)は大喜びでした! これで、チームの春も近いと思われます*^^* が、使用者の一人から、一つだけリクエストが来まして、 行挿入だけは、させて欲しいと言われました。 ですが、下記のソースでは、行挿入も禁止しています。 どうにか、アレンジできる方法はありませんでしょうか? お時間ある時にでも、ご教示願います。m(__)m ---------------------------------------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) Dim Ans As Integer If Target.Count = 1 Then Ans = MsgBox("今、貼り付けたデータ(入力したデータ)は、正しいですか?確認してください。", vbYesNo) If Ans = vbNo Then MsgBox "データを消去します。入力し直して下さい。" With Application .EnableEvents = False .Undo .EnableEvents = True End With End If Exit Sub Else MsgBox "複数セルを同時に変更する事はできません。一データずつ、入力して下さい。" With Application .EnableEvents = False .Undo .EnableEvents = True End With End If End Sub ----------------------------------------------------------------