Officeのクリップボードを操作するvbaモジュール＜参考＞http://www.ka-net.org/office/of56.htmlhttps://msdn.microsoft.com/ja-jp/library/system.windows.forms.access

2/3/2016 - 4:00 AM

Officeのクリップボードを操作するvbaモジュール＜参考＞ http://www.ka-net.org/office/of56.html https://msdn.microsoft.com/ja-jp/library/system.windows.forms.access

Officeのクリップボードを操作するvbaモジュール＜参考＞ http://www.ka-net.org/office/of56.html https://msdn.microsoft.com/ja-jp/library/system.windows.forms.accessiblerole(v=vs.110).aspx

OfficeClipboardManager.vbs

Option Explicit

'/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
'
'Officeのクリップボードを操作します。
'※Office2007以降用
'
'/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/

Private Declare Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, _
                                                          ByVal iChildStart As Long, _
                                                          ByVal cChildren As Long, _
                                                          ByRef rgvarChildren As Any, _
                                                          ByRef pcObtained As Long) As Long

Private Const CHILDID_SELF As Long = 0
Private Const ROLE_SYSTEM_LIST As Long = 33         '一覧
Private Const ROLE_SYSTEM_PROPERTYPAGE As Long = 38 'プロパティページ・・・オブジェクトの外観および動作を制御するダイアログ ボックス
Private Const ROLE_SYSTEM_PUSHBUTTON As Long = 43   'ボタン
Private Const ROLE_SYSTEM_WINDOW As Long = 9        'ウィンドウ

'Officeクリップボードクリア
Public Sub ClearAll()
    Call DoActionOfficeClipboard("すべてクリア")
End Sub

'Officeクリップボード全て貼付
Public Sub PasteAll()
    Call DoActionOfficeClipboard("すべて貼り付け")
End Sub

'Officeクリップボードに登録されているアイテムを貼り付け
Public Sub PasteOfficeClipboardItem(ByVal num As Long)
    Dim acc As Office.IAccessible
    Set acc = GetAccOfficeClipboardList
    
    If acc Is Nothing Then
        Exit Sub
    End If
    
    If (acc.accChildCount = 1) And (InStr(acc.accName(1), "クリップボードは空")) Then
        Call MsgBox("クリップボードは空です。" & vbCrLf & "処理を中止します。", vbCritical + vbSystemModal)
        Exit Sub
    End If
    
    If num > acc.accChildCount Then
        MsgBox "指定した番号は無効です。" & vbCrLf & "処理を中止します。", vbCritical + vbSystemModal
    Exit Sub
    End If
    Call acc.accDoDefaultAction(num)
End Sub

'Officeクリップボードコマンド実行
Private Sub DoActionOfficeClipboard(ByVal accObjName As String)
    Application.CommandBars("Office Clipboard").Visible = True
    DoEvents
    
    'Officeクリップボード取得
    Dim acc As Office.IAccessible
    Set acc = Application.CommandBars("Office Clipboard")
    Set acc = GetAcc(acc, "Collect and Paste 2.0", ROLE_SYSTEM_WINDOW)          'クリップボードのウィンドウを捕捉
    Set acc = GetAcc(acc, "Collect and Paste 2.0", ROLE_SYSTEM_PROPERTYPAGE)    'クリップボードウィンドウ内の要素捕捉
    
    Dim count As Long
    count = acc.accChildCount
    If Not count > 0 Then
        Exit Sub
    End If
    
    Dim i As Long
    For i = 0 To count
        If acc.accName(i) = accObjName And acc.accRole(i) = ROLE_SYSTEM_PUSHBUTTON Then
            Call acc.accDoDefaultAction(i)
            Exit For
        End If
    Next
End Sub

'Officeクリップボードリスト取得
Private Function GetOfficeClipboardList() As Collection
    
    Set GetOfficeClipboardList = New Collection
    
    Dim acc As Office.IAccessible
    Set acc = GetAccOfficeClipboardList
    If acc Is Nothing Then
        Exit Function
    End If
    
    Dim count As Long
    count = acc.accChildCount
    
    If count = 1 And InStr(acc.accName(1), "クリップボードは空") Then
        MsgBox "クリップボードは空です。" & vbCrLf & "処理を中止します。", vbCritical + vbSystemModal
        Exit Function
    End If
    
    Dim i As Long
    For i = 1 To count
      Call GetOfficeClipboardList.Add(acc.accName(i))
    Next
End Function

'Officeクリップボードリスト(Accessibleオブジェクト)取得
Private Function GetAccOfficeClipboardList() As Office.IAccessible
    Dim acc As Office.IAccessible
    
    Application.CommandBars("Office Clipboard").Visible = True
    DoEvents
    Set acc = Application.CommandBars("Office Clipboard")
    Set acc = GetAcc(acc, "Collect and Paste 2.0", ROLE_SYSTEM_WINDOW)
    Set acc = GetAcc(acc, "Collect and Paste 2.0", ROLE_SYSTEM_PROPERTYPAGE)
    Set acc = GetAcc(acc, "クリップボード", ROLE_SYSTEM_LIST)
    Set GetAccOfficeClipboardList = acc
End Function

'Accessibleオブジェクト取得
'オブジェクト名とロールに一致するAccessibleオブジェクトを返却する
Private Function GetAcc(acc As Office.IAccessible, accName As String, accRole As Long) As Office.IAccessible
    
    If (acc.accState(CHILDID_SELF) <> 32769) And _
       (acc.accName(CHILDID_SELF) = accName) And _
       (acc.accRole(CHILDID_SELF) = accRole) Then
        Set GetAcc = acc
        Exit Function
    End If
      
    Dim count As Long
    count = acc.accChildCount
    If count > 0 Then
        Exit Function
    End If
    
    Dim list() As Variant
    ReDim list(count - 1)
    
    Dim childAcc As Office.IAccessible
    If AccessibleChildren(acc, 0, ByVal count, list(0), count) <> 0 Then
        Exit Function
    End If
    
    Dim i As Long
    For i = LBound(list) To UBound(list)
        If TypeOf list(i) Is Office.IAccessible Then
            Set childAcc = list(i)
            Set GetAcc = GetAcc(childAcc, accName, accRole)
        End If
        If Not GetAcc Is Nothing Then
            Exit For
        End If
    Next
End Function

AccState

値（16進）		定義							意味
---------------+-------------------------------+--------------------
 &h00000000		STATE_SYSTEM_NORMAL
 &h00000001		STATE_SYSTEM_UNAVAILABLE 		使用不可
 &h00000002		STATE_SYSTEM_SELECTED 			選択されている
 &h00000004		STATE_SYSTEM_FOCUSED 			フォーカスされている
 &h00000008		STATE_SYSTEM_PRESSED 			押下されている
 &h00000010		STATE_SYSTEM_CHECKED 			チェック
 &h00000020		STATE_SYSTEM_MIXED
 &h00000040		STATE_SYSTEM_READONLY 			読み取り専用
 &h00000080		STATE_SYSTEM_HOTTRACKED
 &h00000100		STATE_SYSTEM_DEFAULT
 &h00000200		STATE_SYSTEM_EXPANDED 			展開されている
 &h00000400		STATE_SYSTEM_COLLAPSED
 &h00000800		STATE_SYSTEM_BUSY
 &h00001000		STATE_SYSTEM_FLOATING 			フローティング
 &h00002000		STATE_SYSTEM_MARQUEED
 &h00004000		STATE_SYSTEM_ANIMATED
 &h00008000		STATE_SYSTEM_INVISIBLE 			不可視
 &h00010000		STATE_SYSTEM_OFFSCREEN
 &h00020000		STATE_SYSTEM_SIZEABLE 			サイズ変更可
 &h00040000		STATE_SYSTEM_MOVEABLE 			移動可
 &h00080000		STATE_SYSTEM_SELFVOICING
 &h00100000		STATE_SYSTEM_FOCUSABLE 			フォーカス可
 &h00200000		STATE_SYSTEM_SELECTABLE 		選択可
 &h00400000		STATE_SYSTEM_LINKED 			リンク
 &h00800000		STATE_SYSTEM_TRAVERSED
 &h01000000		STATE_SYSTEM_MULTISELECTABLE 	複数選択可
 &h02000000		STATE_SYSTEM_EXTSELECTABLE 		拡張選択
 &h04000000		STATE_SYSTEM_ALERT_LOW
 &h08000000		STATE_SYSTEM_ALERT_MEDIUM
 &h10000000		STATE_SYSTEM_ALERT_HIGH
 &h1FFFFFFF		STATE_SYSTEM_VALID
 &h40000000		STATE_SYSTEM_HASPOPUP

AccRole

値（10進）	定義							意味
-----------+--------------------------------+--------------
 1			ROLE_SYSTEM_TITLEBAR			タイトルバー
 2			ROLE_SYSTEM_MENUBAR				メニューバー
 3			ROLE_SYSTEM_SCROLLBAR			スクロールバー
 4			ROLE_SYSTEM_GRIP				グリップ
 5			ROLE_SYSTEM_SOUND				サウンド
 6			ROLE_SYSTEM_CURSOR				カーソル
 7			ROLE_SYSTEM_CARET				キャレット
 8			ROLE_SYSTEM_ALERT				アラート
 9			ROLE_SYSTEM_WINDOW				ウィンドウ
10			ROLE_SYSTEM_CLIENT				クライアント
11			ROLE_SYSTEM_MENUPOPUP			メニュー
12			ROLE_SYSTEM_MENUITEM			メニュー項目
13			ROLE_SYSTEM_TOOLTIP				ツールヒント
14			ROLE_SYSTEM_APPLICATION			アプリケーション
15			ROLE_SYSTEM_DOCUMENT			ドキュメント
16			ROLE_SYSTEM_PANE				ペイン
17			ROLE_SYSTEM_CHART				チャート
18			ROLE_SYSTEM_DIALOG				ダイアログ
19			ROLE_SYSTEM_BORDER				境界線
20			ROLE_SYSTEM_GROUPING			グループ
21			ROLE_SYSTEM_SEPARATOR			区分線
22			ROLE_SYSTEM_TOOLBAR				ツールバー
23			ROLE_SYSTEM_STATUSBAR			ステータスバー
24			ROLE_SYSTEM_TABLE				テーブル
25			ROLE_SYSTEM_COLUMNHEADER		列見出し
26			ROLE_SYSTEM_ROWHEADER			行見出し
27			ROLE_SYSTEM_COLUMN				列
28			ROLE_SYSTEM_ROW					行
29			ROLE_SYSTEM_CELL				セル
30			ROLE_SYSTEM_LINK				リンク
31			ROLE_SYSTEM_HELPBALLOON			ヘルプボタン
32			ROLE_SYSTEM_CHARACTER			キャラクタ
33			ROLE_SYSTEM_LIST				一覧
34			ROLE_SYSTEM_LISTITEM			一覧項目
35			ROLE_SYSTEM_OUTLINE				ツリー
36			ROLE_SYSTEM_OUTLINEITEM			ツリー項目
37			ROLE_SYSTEM_PAGETAB				タブ項目
38			ROLE_SYSTEM_PROPERTYPAGE		プロパティページ
39			ROLE_SYSTEM_INDICATOR			つまみ
40			ROLE_SYSTEM_GRAPHIC				イメージ
41			ROLE_SYSTEM_STATICTEXT			固定テキスト
42			ROLE_SYSTEM_TEXT				テキスト
43			ROLE_SYSTEM_PUSHBUTTON			ボタン
44			ROLE_SYSTEM_CHECKBUTTON			チェックボックス
45			ROLE_SYSTEM_RADIOBUTTON			オプションボタン
46			ROLE_SYSTEM_COMBOBOX			コンボボックス
47			ROLE_SYSTEM_DROPLIST			ドロップリスト
48			ROLE_SYSTEM_PROGRESSBAR			進行状況バー
49			ROLE_SYSTEM_DIAL				ダイヤル
50			ROLE_SYSTEM_HOTKEYFIELD			ホットキーフィールド
51			ROLE_SYSTEM_SLIDER				スライダー
52			ROLE_SYSTEM_SPINBUTTON			スピンボタン
53			ROLE_SYSTEM_DIAGRAM				ダイアグラム
54			ROLE_SYSTEM_ANIMATION			アニメーション
55			ROLE_SYSTEM_EQUATION			EQUATION
56			ROLE_SYSTEM_BUTTONDROPDOWN		ボタンドロップダウン
57			ROLE_SYSTEM_BUTTONMENU			ボタンメニュー
58			ROLE_SYSTEM_BUTTONDROPDOWNGRID	ボタンドロップダウングリッド
59			ROLE_SYSTEM_WHITESPACE			空白域
60			ROLE_SYSTEM_PAGETABLIST			タブ
61			ROLE_SYSTEM_CLOCK				時計
62			ROLE_SYSTEM_SPLITBUTTON			分割ボタン
63			ROLE_SYSTEM_IPADDRESS			IPアドレス

Cacher is the code snippet organizer for pro developers

We empower you and your team to get more done, faster

Officeのクリップボードを操作するvbaモジュール ＜参考＞ http://www.ka-net.org/office/of56.html https://msdn.microsoft.com/ja-jp/library/system.windows.forms.access

Officeのクリップボードを操作するvbaモジュール＜参考＞ http://www.ka-net.org/office/of56.html https://msdn.microsoft.com/ja-jp/library/system.windows.forms.access