Office関連

Internet Explorerのタブを切り替えるVBAマクロ

前回の記事でInternet Explorerを操作するVBAマクロを紹介しましたが、ついでにURLを指定して、Internet Explorerのタブを切り替えるマクロも書いてみました。

※ 64ビット版Officeではコードを書きかえる必要があります。

'UIAutomationClient(UIAutomationCore.dll)要参照
Option Explicit

Private Declare Function FindWindowEx Lib "User32" Alias "FindWindowExA" ( _
  ByVal hWndParent As Long, _
  ByVal hWndChildAfter As Long, _
  ByVal lpszClass As String, _
  ByVal lpszWindow As String) As Long
Private Declare Function ShowWindow Lib "User32" ( _
  ByVal hWnd As Long, _
  ByVal nCmdShow As Long) As Long
Private Const SW_SHOWNORMAL = 1

Public Sub Sample()
  SelectIETab "weather.yahoo.co.jp"
End Sub

Private Sub SelectIETab(ByVal url As String)
'指定したURLのタブに切り替える
  Dim ie As Object
  Dim uiAuto As CUIAutomation
  Dim elmNavBar As IUIAutomationElement
  Dim elmTabs As IUIAutomationElement
  Dim aryTabs As IUIAutomationElementArray
  Dim ptnSelectionItem As IUIAutomationSelectionItemPattern
  Dim cnd As IUIAutomationCondition
  Dim hNavBar As Long, i As Long
  
  Set ie = GetActiveIE(url)
  If ie Is Nothing Then Exit Sub
  ShowWindow ie.hWnd, SW_SHOWNORMAL '最少化時を考慮してウィンドウを元に戻す
  hNavBar = FindWindowEx(ie.hWnd, 0, "WorkerW", vbNullString) 'ナビゲーション バー
  If hNavBar = 0 Then Exit Sub
  Set uiAuto = New CUIAutomation
  Set elmNavBar = uiAuto.ElementFromHandle(ByVal hNavBar)
  If elmNavBar Is Nothing Then Exit Sub
  Set elmTabs = GetElement(uiAuto, _
                           elmNavBar, _
                           UIA_NamePropertyId, _
                           "タブ行", _
                           UIA_TabControlTypeId)
  If elmTabs Is Nothing Then Exit Sub
  Set cnd = uiAuto.CreatePropertyCondition( _
              UIA_ControlTypePropertyId, _
              UIA_TabItemControlTypeId _
            )
  Set aryTabs = elmTabs.FindAll(TreeScope_Subtree, cnd)
  For i = 0 To aryTabs.Length - 1
    'LegacyIAccessible.DescriptionにURLが含まれているかを判断してタブ選択
    If InStr(aryTabs.GetElement(i).GetCurrentPropertyValue(UIA_LegacyIAccessibleDescriptionPropertyId), _
             ie.LocationURL) Then
      Set ptnSelectionItem = aryTabs.GetElement(i).GetCurrentPattern(UIA_SelectionItemPatternId)
      ptnSelectionItem.Select
      Exit For
    End If
  Next
End Sub

Private Function GetActiveIE(ByVal url As String) As Object
'URLを指定して起動中のIE取得
  Dim o As Object
  
  For Each o In GetObject("new:{9BA05972-F6A8-11CF-A442-00A0C90A8F39}") 'ShellWindows
    If LCase(TypeName(o)) = "iwebbrowser2" Then
      If LCase(TypeName(o.Document)) = "htmldocument" Then
        If o.LocationURL Like "*" & url & "*" Then
          Set GetActiveIE = o
          Exit For
        End If
      End If
    End If
  Next
End Function

Private Function GetElement(ByVal uiAuto As CUIAutomation, _
                            ByVal elmParent As IUIAutomationElement, _
                            ByVal propertyId As Long, _
                            ByVal propertyValue As Variant, _
                            Optional ByVal ctrlType As Long = 0) As IUIAutomationElement
  Dim cndFirst As IUIAutomationCondition
  Dim cndSecond As IUIAutomationCondition
   
  Set cndFirst = uiAuto.CreatePropertyCondition( _
                   propertyId, _
                   propertyValue _
                 )
  If ctrlType <> 0 Then
    Set cndSecond = uiAuto.CreatePropertyCondition( _
                      UIA_ControlTypePropertyId, _
                      ctrlType _
                    )
    Set cndFirst = uiAuto.CreateAndCondition( _
                     cndFirst, _
                     cndSecond _
                   )
  End If
  Set GetElement = elmParent.FindFirst(TreeScope_Subtree, cndFirst)
End Function

selectietab_01

上図の通り、Windows 10 + Internet Explorer 11環境でも動作しましたが、あまり出番はなさそうなマクロです。

関連Webページ

Google翻訳で文字列を翻訳するVBAマクロ(IE操作版)前のページ

【連載再開】僕と君の大切な話次のページ

関連記事

  1. Office アドイン

    PowerPoint用のOffice用アプリ

    当ブログでも散々紹介しているOffice用アプリ(apps for O…

  2. Office関連

    Adobe Readerを利用してPDFファイルのページ数を取得するVBAマクロ

    mougの回答用に書いたコードです。mougは半年でログが消えてし…

  3. Office関連

    Wordのテンプレートをインストールするスクリプト

    Wordマクロをテンプレートにして使用する場合、通常そのテンプレートフ…

  4. Office アドイン

    [Office用アプリ]Bing Maps for Accessの紹介

    Microsoft Download CenterでAccess向けO…

  5. Office関連

    セル内にあるブックマークをカウントするWordマクロ

    Twitterを眺めていたら下記ツイートを発見しました。【Wo…

コメント

  • コメント (0)

  • トラックバックは利用できません。

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

PAGE TOP