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ページ

関連記事

  1. Office関連

    「ちゃうちゃう!」で2つの文書を比較するWordマクロ

    2014/08/10 追記:ちゃうちゃう!がバージョンアップされま…

  2. Office関連

    Google スライドで新規プレゼンテーションを作成するVBAマクロ

    ここ数日PowerPointのマクロに加え、Google Apps S…

  3. Office関連

    選択したセルに連続行番号を振るWordマクロ

    Wordでマニュアルを作成するとき等、表の中で連番を振りたいときがよく…

  4. Office関連

    プログラムのソースコードを別の言語に変換するVBAマクロ

    SharpDevelopが公開している、ソースコードを変換するAPI「…

  5. Office関連

    「個人用テンプレートの既定の場所」を設定するWordマクロ

    前回の記事で、Word 2013で個人用テンプレート(カスタム テンプ…

  6. Office関連

    Office 365 APIをVBAから呼び出す(1)

    2015年4月に公開されたOffice Teamのブログ記事「Toda…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP