【ExcelVBA】複数のセル範囲でブラウザ検索するコード例【マクロ】

選択範囲のセルの数だけ、ウェブブラウザ(Firefox, Chrome)のタブを開くマクロです。

複数のセルをまとめて選んで、ブラウザのタブを一気に開くために作りました。

ウェブ検索したいセルが３つあるときに、１クリックでブラウザタブを３つ開くことができます。

そのマクロのコード例です。

ExcelVBA（エクセルブイビーエー）のマクロで作りました。

※ LibreOffice（リブレオフィス）版も作りました

コード例

以下がマクロのコード例です。

ウェブブラウザの実行ファイルパスだけ変更すれば、たぶん動くと思います。

ツールバーへの登録方法は、１セル専用のマクロの記事に画像で載せています。

うっかり大量のセルを選択して実行しちゃった時のために、上限『n_max』で止まるように作っています。上限は適当に変えてくださいませ。

'関数 Sleep(ミリ秒) の宣言
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


'サーチツイッター関数
Sub SearchTwitter()
    'ウェブブラウザの実行ファイルパスを定義
    Dim browser_exe As String
    'browser_exe = "F:\apps\FirefoxPortable\FirefoxPortable.exe"
    browser_exe = "F:\apps\IronPortable64\IronPortable.exe"
    '(※ ファイルパスは、ご自身の環境に合わせて変更してください。)

    'ウェブブラウザの引数(ひきすう)を定義
    Dim browser_param As String
    browser_param = "" '今回は使わないので空(から)文字列を設定

    'ウェブサイトのURL文字列を定義
    '検索キーワードの前に来る部分と後ろに来る部分で、
    '2つに分けて定義しておきます。
    Dim url_1 As String
    Dim url_2 As String
    url_1 = "https://twitter.com/search?q="
    url_2 = "" '今回は使わないので空(から)文字列を設定

    'ウェブブラウザで開く
    Call OpenBrowser(browser_exe, browser_param, url_1, url_2)
End Sub


'オープンブラウザ関数
Private Sub OpenBrowser( _
    ByRef browser_exe As String, _
    ByRef browser_param As String, _
    ByRef url_1 As String, _
    ByRef url_2 As String _
    )
    '■ OpenBrowser()が受け取った変数は何か？
    'browser_exe: ブラウザの実行ファイルパス
    'browser_param: ブラウザに渡す引数
    'url_1: 検索キーワードの前に来るURL
    'url_2: 検索キーワードのうしろに来るURL

    '■ OpenBrowser()がすることは？
    '選択中のセルからテキストを取得して、ウェブブラウザに渡す。

    '■ どうやってやるの？
    ' 1. 選択中の『セル範囲』を取得 ActiveWindow.RangeSelection
    ' 2. 選択中の『セル』を1つずつ取得 For Each In Next
    ' 3. 選択セルから『テキスト』を取得 .Value
    ' 4. テキストが文字化けしないようにエンコード encodeURIComponent()
    ' 5. URLを組み立てる 文字列連結
    ' 6. Shell()の引数を組み立てる 文字列連結
    ' 7. ブラウザを起動 Shell()


    ' 1. セル範囲を取得
    Dim cs As Range
    If ActiveWindow.RangeSelection.count = 1 Then
        '選択セルが『ひとつ』の場合
        Set cs = ActiveWindow.RangeSelection

        '※ セルの取得は RangeSelection だけを使う。
        'SpecialCells(xlCellTypeVisible)をつけると、
        '予期しないセルが対象になってしまう。
    Else
        '選択セルが『複数』の場合
        Set cs = ActiveWindow.RangeSelection.SpecialCells(xlCellTypeVisible)
        
        '※ SpecialCells(xlCellTypeVisible)をつけて、
        '選択中の『可視セル』だけを取得する。
        'SpecialCells(xlCellTypeVisible)をつけることで、
        'オートフィルタを使った時も、見えているセルだけを
        '対象にすることができます。
    End If

    'セルオブジェクト
    Dim c As Range

    'セルの文字列
    Dim t As String

    'URL文字列
    Dim site_url As String

    'シェルに渡す文字列
    Dim p As String

    'セル数のカウンタ
    Dim n As Long: n = 1

    'セル数の上限
    Const n_max As Long = 10

    '待機時間(ミリ秒)
    Const time_wait As Long = 400 'ms

    ' 2. 選択中の『セル』を1つずつ取得
    For Each c In cs
        ' 3. 選択セルから『テキスト』を取得
        '(このテキストが検索キーワードになります)
        t = c.Value

        'セルが空欄でないこと
        If Not t = "" Then
            ' 4. テキストが文字化けしないようにエンコード
            '(UnicodeのUTF-8エンコーディングの16進数に変換)
            '(たとえば、『あ』は『%E3%81%82』になります)
            '(半角スペースなら『%20』)
            With CreateObject("ScriptControl")
                .Language = "JavaScript"
                t = .CodeObject.encodeURIComponent(t)
            End With

            ' 5. URLを組み立てる
            '(検索キーワードの後ろが空(から)文字列なら省略)
            '(4つの連続ダブルクオーテーション『""""』は、
            '1つのダブルクオーテーションを出すためのものです)
            If url_2 = "" Then
                '検索キーワードの後ろを省略
                site_url = """" & url_1 & t & """"
            Else
                site_url = """" & url_1 & t & url_2 & """"
            End If

            ' 6. Shell()の引数を組み立てる
            '(半角スペースで区切って連結しています)
            If browser_param = "" Then
                p = """" & browser_exe & """" & " " & site_url
            Else
                p = """" & browser_exe & """" & " " & site_url & " " & browser_param
            End If

            ' 7. ブラウザを起動 (windowstyleは省略)
            Call Shell(p)
            Call Sleep(time_wait)

            DoEvents
        End If

        '上限に達していたら終了
        If n > n_max Then
            Exit For
        Else
            n = n + 1
        End If
    Next
    Set c = Nothing
    Set cs = Nothing
End Sub