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 アドイン

    [Office用アプリ]仕事の息抜きにピッタリ「もぐらミニ」

    KumaP氏作の作業ウィンドウアプリ「もぐらミニ」がOffice スト…

  2. Office関連

    日本語の文法上の誤りを列挙して修正候補をコメントとして追加するWordマクロ

    前回の記事の関連で、今度は日本語の文法上の誤りを列挙して修正候補をコメ…

  3. アイコン一覧

    Office 2013 アイコン一覧(I)

    ・Office 2013 アイコン一覧 NUM…

  4. Office関連

    Office 2010 開発者用リファレンスをHTML形式で”快適に”閲覧す…

    前回の記事で7-Zipを使ってHXS形式のOffice製品のヘルプを解…

  5. Office関連

    各スライドに配置されたオートシェイプからテキストを取得するPowerPointマクロ

    各スライドに配置されたオートシェイプからテキストを抜き出す処理を考えて…

コメント

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

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

Time limit is exhausted. Please reload CAPTCHA.

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

Translate

最近の記事

アーカイブ

PAGE TOP