| |
▼無頼斎 さん：
> それを避けるべく、当該シートが集計されている場合は、"集計されています"や
> "集計を解除してから、貼り付けて下さい"などのメッセージボックスを、
> 貼り付ける作業の前に入れたいのです。できますでしょうか？
すみません。貼り付けの前にメッセージ出力する方法は分かりません。
（Worksheet_BeforChangeイベントが無いので出来ないかもしれません）
代替案を考えてみました。
当該シートがアクティブになった際、
集計がされていれば、クリップボードをクリアする。
という方法です。
集計の判定は、OutlineLevelプロパティを使ってみました。
なので、「集計方法」により使えないかもしれません。
'==== ワークシートモジュールに書く =====
Private Sub Worksheet_Activate()
Dim myCB As Variant
If Range("A3").CurrentRegion.Rows(2).OutlineLevel <> 1 Then
'見出し行が３行目を想定 --> ４行目のOutlineLevelを判定
myCB = Application.ClipboardFormats
If Not myCB(1) Then
MsgBox "集計をはずすまで、貼り付けできません"
End If
Call sub_OfficeClipboardClear
End If
End Sub
'===========================
クリップボードクリアは、検索すると結構出てきます。
一応、よさげなものをパクってきました。
'==== 標準モジュールに =========================
Option Explicit
'Microsoft Office のライブラリに参照設定要(既定で参照済み)
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" _
(ByVal hWnd As Long, ByVal dwId As Long, _
riid As Any, ppvObject As Any) As Long
Const OBJID_CLIENT = &HFFFFFFFC
Private Declare Function IIDFromString Lib "ole32" _
(lpsz As Any, lpiid As Any) As Long
Const IID_IAccessible = "{618736E0-3C3D-11CF-810C-00AA00389B71}"
Private Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" _
(ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
ByVal lpszClass As String, ByVal lpszWindow As String) As Long
'クリップボードクリア
Private Declare Function OpenClipboard Lib "user32" _
(ByVal hWndNewOwner As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
'
Sub sub_OfficeClipboardClear()
Dim IID(0 To 3) As Long
Dim acc As IAccessible
Dim h As Long
Application.CommandBars("worksheet menu bar").Controls("編集(&E)") _
.Controls("Office クリップボード(&B)...").Execute
Application.Visible = True
Application.Wait Now + TimeSerial(0, 0, 0.5)
h = FindWindowEx(Application.hWnd, 0, "EXCEL2", vbNullString)
h = FindWindowEx(h, 0, "MsoCommandBar", "作業ウィンドウ")
h = FindWindowEx(h, 0, "MsoWorkPane", vbNullString)
h = FindWindowEx(h, 0, "bosa_sdm_XL9", vbNullString)
' ウィンドウからIAccessibleを取り出す
IIDFromString ByVal StrPtr(IID_IAccessible), IID(0)
If AccessibleObjectFromWindow( _
h, OBJID_CLIENT, IID(0), acc) < 0 Then
Exit Sub ' エラー時
End If
'すべてクリアボタンの実行。
acc.accDoDefaultAction 2&
Set acc = Nothing
'クリップボードクリア
If OpenClipboard(0) Then
EmptyClipboard
CloseClipboard
End If
End Sub
'===========================
欠点として、「貼り付けの際」ではなく、「シートがアクティブになった際」に
処理してます。
よって、クリップボードにデータがあると、貼り付けるつもりがなくても、
強制的にクリアされます。
また、クリップボードクリアの際（シートがアクティブの際）に、
作業ウィンドウが表示されます。
このウィンドウの消し方は分かりませんでした。（分かる方、ヘルプです）
オフィスクリップボードは使わないよ、というのであれば、
Sub内は、最後の５行のみで良いです。
その場合は、作業ウィンドウは表示されません。
とりあえず、今の私のスキルでは、この方法が精一杯です。
一応、参考までに。
|
|
飛ばない豚
- 06/12/20(水) 13:06 -
