| |
▼ささ さん：
初めのコードは切取に反応しませんでした。
条件分岐が複雑なので、修正を繰り返してたら、切取の確認を忘れてました。
修正コードを提示します。
一応コピペ、カット＆ペースト、値のみコピペの基本的な使い方では不具合は無いと思いますが(全部は検証しきれてないので絶対大丈夫とは言い切れないですが)、カットモードにして直接入力など、ユーザーはどんな使い方するか分からないので、意図しない動きをする可能性はあります。
もし不具合が起きたら、また質問して下さい。
(対処可能かどうかは保証できませんが)
後Undoした時は都度MsgBoxが出てくると思いますが、これはVBAでは対処不可能です。
多分全て「はい」で良いと思いますが、逆のパターンもありうるので、そこは使用者に慣れてもらうしかないです。
VBAではMsgBoxとの併用は限界があります。
APIでキーのクリックの常時監視などをすれば、大抵の事は対処できますが、Undoが効かなくなるのと、Undoをクリックした時の処置はAPIでも不可能と思います。
もう複雑すぎて説明は無理です。
ThisWorkbookモジュールに丸ごとコピペして下さい。
Private Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "User32" () As Long
Private Declare Function EmptyClipboard Lib "User32" () As Long
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Ans As Integer
Dim cb As Object, cbID As Integer, val
Dim val1, cnt As Long
Dim v, str1 As String
Dim flg As Boolean, mode1 As Variant
Application.EnableEvents = False
mode1 = modeID(0, Target)
If mode1(1) > 0 Then
cbID = Application.ClipboardFormats(1)
If cbID > -1 Or mode1(0) > 0 Then
If Application.CutCopyMode Then
flg = True
Else
val1 = Target.Value
cnt = Selection.Count
If cbID > -1 Then
Set cb = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
cb.GetFromClipboard
val = cb.GetText
If cnt = 1 Then
If InStr(val1, val) > 0 Then flg = True
Else
flg = True
For Each v In val1
If v <> "" Then
If InStr(val, v) = 0 Then
flg = False
Exit For
End If
End If
Next v
End If
Else
If mode1(0) = 2 Then flg = True
End If
End If
If Selection.Address <> mode1(2) And mode1(0) <> 2 Then flg = False
If flg Then
Ans = MsgBox("本当に貼り付けますか？", vbYesNo, "確認")
If Ans = vbNo Then
MsgBox "正しいデータを貼り付けてください"
Application.Undo
OpenClipboard (0&)
EmptyClipboard
CloseClipboard
End If
End If
End If
End If
If mode1(0) < 2 Then Call modeID(2, Target)
Application.EnableEvents = True
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Call modeID(1, Target)
End Sub
Function modeID(ID As Integer, rng As Range) As Variant
Static CopyMode As Integer, i As Integer, tgt As String
tgt = ""
Select Case ID
Case 0
If i = 0 Then
i = 1
Else
i = 0
CopyMode = 0
End If
Case 1
CopyMode = Application.CutCopyMode
tgt = rng.Address
i = 0
Case 2
i = 0
CopyMode = 0
End Select
If tgt = "" Then tgt = rng.Address
modeID = Array(CopyMode, i, tgt)
End Function
▼マナ さん：
>途中で考えるのが、いやになっちゃいます。
同感です。
途中で訳わからなくなってきました。
>選択制にしたい場合は、変数を用意して、必要に応じて、
>コピペ禁止モードを解除する運用でもよいかもしれません。
>If IsCopyOK then exit sub
>みたいな感じにすれば、学校のコードが使えるかなと思います。
完全禁止なら対処も簡単ですね。
不具合も出ないでしょうし、私も選択制をお勧めします。
|
|
sy
- 16/6/12(日) 21:16 -
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
