Skip to content

Instantly share code, notes, and snippets.

@toagit
Created February 3, 2016 04:00
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save toagit/54f3c655c3c300f1f1b8 to your computer and use it in GitHub Desktop.
Save toagit/54f3c655c3c300f1f1b8 to your computer and use it in GitHub Desktop.
値(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アドレス
値(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
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