Office クリップボードをマクロで操作する(UI Automation)

ホーム
Office関連, Excel, Word, PowerPoint
Office クリップボードをマクロで操作する(UI Automation)

2014.10.16

Office クリップボードをマクロで操作する(UI Automation)

以前MSAAを利用してOffice クリップボードを操作するマクロを書いたことがあるのですが、

・Office 2007/2010・リボンのカスタマイズ初心者備忘録
//www.ka-net.org/office/of55.html
・Office 2007/2010・リボンのカスタマイズ初心者備忘録
//www.ka-net.org/office/of56.html

今回は上記マクロをUI Automationを使う形に書き直してみました。

※ UIAutomationClient(UIAutomationCore.dll)要参照
※ UIAutomationClient参照時にエラーが発生する場合は「UIAutomationClient参照時にDLL読み込みエラーが発生した時の対処法」参照

Private Sub DoActionOfficeClipboard(ByVal ButtonName As String)
'Officeクリップボードコマンド実行
  Dim uiAuto As UIAutomationClient.CUIAutomation
  Dim accClipboard As Office.IAccessible
  Dim elmClipboard As UIAutomationClient.IUIAutomationElement
  Dim elmButton As UIAutomationClient.IUIAutomationElement
  Dim cndButtons As UIAutomationClient.IUIAutomationCondition
  Dim aryButtons As UIAutomationClient.IUIAutomationElementArray
  Dim ptnAcc As UIAutomationClient.IUIAutomationLegacyIAccessiblePattern
  Dim i As Long
  
  Set elmButton = Nothing '初期化
  Set uiAuto = New UIAutomationClient.CUIAutomation
  With Application
    .CommandBars("Office Clipboard").Visible = True
    DoEvents
    Set accClipboard = .CommandBars("Office Clipboard")
  End With
  Set elmClipboard = uiAuto.ElementFromIAccessible(accClipboard, 0)
  Set cndButtons = uiAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ButtonControlTypeId)
  Set aryButtons = elmClipboard.FindAll(TreeScope_Subtree, cndButtons)
  For i = 0 To aryButtons.Length - 1
    If aryButtons.GetElement(i).CurrentName = ButtonName Then
      Set elmButton = aryButtons.GetElement(i)
      Exit For
    End If
  Next
  If elmButton Is Nothing Then Exit Sub
  If elmButton.CurrentIsEnabled <> False Then
    Set ptnAcc = elmButton.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
    ptnAcc.DoDefaultAction
  End If
End Sub

Private Sub PasteOfficeClipboardListItem(ByVal ItemNum As Long)
'Officeクリップボードに登録されているアイテムを貼り付け
  Dim aryListItems As UIAutomationClient.IUIAutomationElementArray
  Dim ptnAcc As UIAutomationClient.IUIAutomationLegacyIAccessiblePattern
  
  Set aryListItems = GetOfficeClipboardListItems
  If (aryListItems.Length = 1) And _
     (InStr(aryListItems.GetElement(0).CurrentName, "クリップボードは空です")) Then
    MsgBox "クリップボードは空です。" & vbCrLf & _
           "処理を中止します。", vbCritical + vbSystemModal
    Exit Sub
  End If
  If (ItemNum > aryListItems.Length) Or _
     (ItemNum < 1) Then
    MsgBox "現在指定できる番号は [1 - " & aryListItems.Length & "]までです。" & vbCrLf & _
           "処理を中止します。", vbCritical + vbSystemModal
    Exit Sub
  End If
  Set ptnAcc = aryListItems.GetElement(ItemNum - 1).GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
  ptnAcc.DoDefaultAction
End Sub

Private Function GetOfficeClipboardListItems() As UIAutomationClient.IUIAutomationElementArray
'Officeクリップボードリスト取得
  Dim uiAuto As UIAutomationClient.CUIAutomation
  Dim accClipboard As Office.IAccessible
  Dim elmClipboard As UIAutomationClient.IUIAutomationElement
  Dim cndListItems As UIAutomationClient.IUIAutomationCondition
  
  Set uiAuto = New UIAutomationClient.CUIAutomation
  With Application
    .CommandBars("Office Clipboard").Visible = True
    DoEvents
    Set accClipboard = .CommandBars("Office Clipboard")
  End With
  Set elmClipboard = uiAuto.ElementFromIAccessible(accClipboard, 0)
  Set cndListItems = uiAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ListItemControlTypeId)
  Set GetOfficeClipboardListItems = elmClipboard.FindAll(TreeScope_Subtree, cndListItems)
End Function

使い方は下記の通りで、MSAAのコードに比べると、大分シンプルになっています。

Public Sub Test1()
'Officeクリップボードにあるアイテム列挙
  Dim aryListItems As UIAutomationClient.IUIAutomationElementArray
  Dim i As Long
  
  Set aryListItems = GetOfficeClipboardListItems
  For i = 0 To aryListItems.Length - 1
    Debug.Print i + 1, aryListItems.GetElement(i).CurrentName
  Next
End Sub

Public Sub Test2()
  'DoActionOfficeClipboard "すべて貼り付け"
  DoActionOfficeClipboard "すべてクリア"
End Sub

Public Sub Test3()
'20番目のアイテムを貼り付け
  PasteOfficeClipboardListItem 20
End Sub