Office関連

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

関連記事

[Office用アプリ]第三回 Apps for Office 勉強会で登壇しました。前のページ

UI Automation PowerShell Extensionsを試しに使ってみました。次のページ

関連記事

  1. Office関連

    Presentation Translatorが公開されました。

    下記記事で紹介している「Microsoft Translator アド…

  2. Office関連

    選択している行の高さを増やすExcelマクロ

    Excelの表を印刷しようとしたとき、ビミョーに文字が切れていてイラッ…

  3. Office関連

    関数一覧(Excel 2010)

    関数の挿入ダイアログから抽出したExcel 2010の関数情報をリスト…

  4. Excel

    フォルダ内にあるExcelファイルをカウントするVBScript

    「フォルダ内 Excel 数える VBScript」といったキーワード…

  5. Office アドイン

    [Officeアドイン]テーブルやグラフを作成する方法(Excel)

    お久しぶりのOffice アドインの記事です。注目している人はほと…

  6. Office関連

    Office365APIEditorでMicrosoft Graph APIを手軽に呼び出し!

    下記Tech Communityの記事で、Microsoftのエンジニ…

コメント

  1. この記事へのコメントはありません。

  1. この記事へのトラックバックはありません。

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP