初めての店舗開業を成功させよう>>

ある人が、シート「Sheet1」のセルA1をコピーして
セルB1にペーストしました。

この操作をされたことを知る方法ってありますか?

やりたいことは、セルがペーストされたときに
「A1のセルがB1のセルにコピーペーストされたました。」
とメッセージを表示したいと思っています。

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

A 回答 (3件)

'前回の続き


'---
'クラス(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)
 Dim sRng As String
 Dim msg As String
 On Error Resume Next
 If IsClipboardFormatAvailable(CF_TEXT) = 0 Then Exit Sub
 If ActiveSheet.ProtectContents Then
  MsgBox "セルは保護されています。", vbExclamation
  Exit Sub
 End If
 If ActiveSheet.ProtectContents Then
  If ActiveCell.Locked = False Then
   msg = vbCrLf & "しかし、セルに入力可能です。"
  Else
   msg = ""
  End If
  MsgBox "セルは保護されています。" & msg, vbExclamation
  Exit Sub
 End If
 
 If TypeName(Selection) = "Range" Then
  sRng = Selection.Address(0, 0)
  sRng = sRng & "に"
 Else
  Exit Sub
 End If
 Selection.PasteSpecial
 On Error GoTo 0
 CancelDefault = False
 '二重呼び出しの禁止
 If Pastechk = False Then
  MessageBoxTimeoutA 0&, sRng & "貼り付けされました。", "貼り付け", vbMsgBoxSetForeground, 0, 2000
  Pastechk = True
 Else
  Pastechk = False
 End If
End Sub

'-------
変更点:

・セルをコピーして、貼り付けしないと、メッセージが出ないようにしました。ただ、もう少し改良点が残されています。クリップボードの中を検索する必要があります。

・シート保護されている時には、メッセージが出ます。ただし、アクティブセル自体に書き込み可能な時は、そのセルが入力可能であることを明示するようにしました。

注意点:
・クラスオフジェクトは、現段階では、Excelを終了しないと設定が外れません。ただし、NewBtnSettingの部分で、クラスでボタンのインスンタンスを設ける時に、Nothingなどで設定し直せば、外れるはずです。(未確認)

・こちらの発見した誤動作としては、別の設定したクラスとぶつかると、貼り付けがきかなくなる現象を確認しました。ふつうはありえないことですが、今回のマクロは、PERSONAL.XLSなどの起動用に設定されるところに入れてあげれば問題は減ります。新しくブックを設けても同じように動作します。

・現段階では、Ctrl + Z で、Undo が利きません。一般的にはマクロでは出来ないと言われますが、前の状態に戻すことは可能なはずです。(未確認)

「未確認」部分は、再び、どこかで聞いていただければ、このマクロ全体を公開しなくても、解答可能なはずです。以前、やったことのあるテクニックですが、すぐに思い出せません。
    • good
    • 0
この回答へのお礼

「元に戻す」は機能しないようですね。
それでも、十分すぎるくらいの動作です。

本当にすごいです。
ありがとうございました。

お礼日時:2010/12/21 22:04

>すごいです。

正常に動作確認できました。
最近、OkWaveでは、こういうコードを書くだけで、無視されるケースが多いからです。だから、質問者さんが直接に答えなくてもよいと、#1では、かなり、なげやりな書き方をしてしまいました。失礼な書き方ですみませんでした。

さて、

>シート保護やロックがかかっているセルに貼り付けようとした場合には
>「セルは保護されています」とメッセージを出し、値を貼り付けれない
直しましたが、まだまだ、本当は、改良点が残されています。変更点と改良点は、次の書き込みの最後に書きます。

'標準モジュール
Private ClassBtns(1) As New Class1
Public Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Public Declare Function MessageBoxTimeoutA Lib "user32" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal uType As Long, ByVal wLanguageId As Long, ByVal dwMilliseconds As Long) As Long
Public Pastechk As Boolean
Public Const CF_TEXT As Long = 1&
Public Const CF_BITMAP As Long = 2& '予備
Public Const CF_METAFILEPICT As Long = 3& '予備

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)
   .OnKey "^v", "MsgMacro"
 End With
End Sub

Sub MsgMacro()
Dim sRng As String
Dim msg As String
  On Error Resume Next
  If IsClipboardFormatAvailable(CF_TEXT) = 0 Then Exit Sub
  If ActiveSheet.ProtectContents Then
   If ActiveCell.Locked = False Then
     msg = vbCrLf & "しかし、セルに入力可能です。"
   Else
     msg = ""
   End If
   MsgBox "セルは保護されています。" & msg, vbExclamation
   Exit Sub
  End If
  If TypeName(Selection) = "Range" Then
   sRng = Selection.Address(0, 0)
   sRng = sRng & "に"
  Else
   Exit Sub
  End If
  Selection.PasteSpecial
  On Error GoTo 0
  MessageBoxTimeoutA 0&, sRng & "貼り付けされました。", "貼り付け", vbMsgBoxSetForeground, 0, 2000
End Sub

'次に続く
    • good
    • 0

細かな説明はしません。

なぜかというと、「タスク」としてのご質問内容ではないからです。他にも方法がありますが、Win32APIで処理するか、クラスで処理するか、いずれにしても、キーを監視するか、コマンドを監視するか、どちらかだと思います。

「A1のセルがB1のセルにコピーペーストされたました。」 どこから持ってきて、ということは、その経緯を記録しなければなりませんから、倍のコードになります。また、他のクリップボードからの貼付けもあるからです面倒ですから、割愛しました。
[形式を選択して貼り付け]や、[セル以外への貼り付け]には可動しません。

なお、マクロは、Excel 2003 まです。それ以上では可動しません。

'標準モジュール
Private ClassBtns(1) As New Class1
Public Declare Function MessageBoxTimeoutA Lib "user32" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal uType As Long, ByVal wLanguageId As Long, ByVal dwMilliseconds As Long) As Long
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)
   .OnKey "^v", "MsgMacro"
 End With
End Sub

Sub MsgMacro()
Dim sRng As String
  On Error Resume Next
  If TypeName(Selection) = "Range" Then
   sRng = Selection.Address(0, 0)
   sRng = sRng & "に"
  Else
   Exit Sub
  End If
  Selection.PasteSpecial
  On Error GoTo 0
  MessageBoxTimeoutA 0&, sRng & "貼り付けされました。", "貼り付け", vbMsgBoxSetForeground, 0, 2000
End Sub

----
'Class モジュール (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)
Dim sRng As String
 On Error Resume Next
  If TypeName(Selection) = "Range" Then
   sRng = Selection.Address(0, 0)
   sRng = sRng & "に"
  Else
   Exit Sub
  End If
  Selection.PasteSpecial
 On Error GoTo 0
 CancelDefault = False
 '二重呼び出しの禁止
 If Pastechk = False Then
  MessageBoxTimeoutA 0&, sRng & "貼り付けされました。", "貼り付け", vbMsgBoxSetForeground, 0, 2000
  Pastechk = True
 Else
  Pastechk = False
 End If
End Sub
    • good
    • 0
この回答へのお礼

すごいです。正常に動作確認できました。

ただ、シートが保護されている場合や、セルがロックされている場合は
貼り付けれないようにしたいのですが・・・

シート保護やロックがかかっているセルに貼り付けようとした場合には
「セルは保護されています」とメッセージを出し、値を貼り付けれない
ようにするのは無理でしょうか?

お礼日時:2010/12/20 21:27

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

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


人気Q&Aランキング