Excel VBA で　クリップボード(Clipbord)監視は出来ないものだろうか。
　
樋口忠洋氏のVBStationやMSDN,SetClipboardViewer Visual Basic 6 API Function,

なでしこ-質問掲示板,Delphi コード等見ながら、考えてみた。

イメージ 1


クリップボード監視の考え方


　クリップボード監視の考え方は、VB, Delphi, なでしこを問わず、
　
以下に要約されるようです。

（1）クリップボードに変更があったら知らせてもらえるようにする。

SetClipboardViewer

（2）クリップボードに変更があるとメッセージ WM_DRAWCLIPBOARD が渡される。

　　受け取った通知を次のウィンドウに渡す。
　　
SendMessage

（3）クリップボード監視を取りやめるときは、ChangeClipboardChain を呼ぶ

（4）VB では、ウィンドウが受け取ったメッセージを直接調べるために、

　　フォームをサブクラス化する。（ＶＢＡでもまねしてみよう。）
　　
樋口忠洋氏の解説より

SetClipboardViewer( hwnd As Long :クリップボードビューワのハンドル )
戻り値 正常終了:クリップボード ビューワチェイン内の次のウィンドウのハンドル
異常終了:0
ChangeClipboardChain( hwnd As Long :削除するウィンドウのハンドル
hWndNext As Long :次のウィンドウのハンドル )
戻り値 正常終了:0以外
異常終了:0

クリップボード監視


　連休前まで、xmlHttpを使ったマクロばかり書いてきました。たまには気分を変えて、
　
今回はWin32APIを使ったマクロを考えてみたいと思います。最初に言っておきます。

このマクロは、余りお勧めできません。何故だか分かりませんが、UserFormの

キャプションバーにマウスを近づけると、激しくメモリーを消耗して制御不能になります。

いつも使用は自己責任でお願いします。軽い気持ちで見てください。

標準モジュールのマクロ


　ここでは、Win32APIの宣言のほか、 UserFormのサブクラス化やウインドウプロシージャ
　
の処理を記載しています。今回も、クリップボードのデータを取得するClipBoard_GetData

関数を使用していますが、この記載は省略します。

Win32APIの宣言


Option Explicit

	'クリップボード内容変更通知取得設定（
	'WM_DRAWCLIPBOARDメッセージを受け取ります）
Declare Function SetClipboardViewer Lib "user32" _
    (ByVal hWnd As Long) As Long
'クリップボード内容変更通知解除
Declare Function ChangeClipboardChain Lib "user32" _
    (ByVal hWnd As Long, ByVal hWndNext As Long) As Long

'サブクラス化用
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
    (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    '定数
    Public Const GWL_WNDPROC = (-4) 'ウインドウプロシージャ
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
    (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal MSG As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long
    '定数
    Public Const WM_DRAWCLIPBOARD = &H308   'クリップボードの内容が変更された時
    
    'UserFormのウィンドウハンドル取得の為
Declare Function FindWindow Lib "user32" _
    Alias "FindWindowA" _
    (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
    
    'クリップボードの変更通知を受け取る次のウィンドウがあれば、WM_DRAWCLIPBOARD
    '渡すため。
Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
    (ByVal hWnd As Long, ByVal MSG As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long

'ー変数ー
Public P_hwndNext As Long   '前回のウインドウプロシージャ

ウインドウプロシージャ 


Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, _
        ByVal wParam As Long, ByVal lParam As Long) As Long
WindowProc = CallWindowProc(P_hwndNext, hWnd, uMsg, wParam, lParam)
        'クリップボードの内容変更
       If uMsg = WM_DRAWCLIPBOARD Then
             UserForm1.ChangeClipBoard
        'ここでクリップボードの内容を使用した処理を行います。
        End If
    If UserForm1.hwndPrevClip <> 0 Then
       SendMessage UserForm1.hwndPrevClip, WM_DRAWCLIPBOARD, wParam, lParam
        ' クリップボードの変更通知を受け取る次のウィンドウがあれば、
        ' WM_DRAWCLIPBOARD を渡す。
    End If
End Function

サブクラス化の始まり


Public Sub SubClass(hWnd As Long)
    P_hwndNext = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

サブクラス化オシマイ


Public Sub UnSubClass(hWnd As Long)
    Dim ret As Long
    If P_hwndNext <> 0 Then
        '元のプロシージャアドレスに設定する
        ret = SetWindowLong(hWnd, GWL_WNDPROC, P_hwndNext)
        P_hwndNext = 0
    End If
End Sub

　連休明けの今日は、此処までとします。

次回　UserForm1に書かれているマクロを見てみましょう。
タグ ：
#ソフトウェア