Created
February 3, 2016 04:00
-
-
Save toagit/54f3c655c3c300f1f1b8 to your computer and use it in GitHub Desktop.
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
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
値(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アドレス |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
値(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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment