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
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
値(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
値(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アドレス