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

関連記事

関連記事

  1. Office関連

    [VBA]自動的にフォントサイズを調整する疑似テキストボックス

    前回と同様、環境依存つながりでmougの給湯室に書いたコードを載せてお…

  2. Office アドイン

    [Office用アプリ]メールアプリの配置方法

    OutlookやOutlook Web App上で動作するメールアプリ…

  3. Office関連

    [リボン・カスタマイズ]dropDown要素の初期項目を指定する。

    MSDN フォーラムに「リボン:ドロップダウンリストにlabel初期値…

  4. Office アドイン

    「マイクロソフト Office 用アプリ開発スタートアップガイド」レビュー

    ※ 下記レビューはあくまでも個人的な感想です。日本初(恐らく)…

  5. Office関連

    ルビ(ふりがな)を一括設定するWordマクロ(改良版)

    これまで当ブログではルビを設定するWordマクロについて、いくつか記事…

  6. Office関連

    Unicodeブロックを元に指定した文字が平仮名なのかカタカナなのか漢字なのかを判別するVBAマクロ…

    以前書いた「ルビ(ふりがな)を一括設定するWordマクロ」記事で使った…

コメント

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP