Excelで選択セルのURLを一括で開くマクロ作った
はじめに
Excelで複数のセルに入力されているURLを一括で開けるマクロを作成しました。
似たような機能を持ったツールとして、Chorme拡張機能の「Pasty」があったのですが、以下の2点が気になったので、その点をカバーできるようなものを作成しました。
・上記の拡張機能は対象のURLを一旦コピーする必要があるのですが、コピーする際にURL以外の文字列が含まれていた場合に、警告などが表示されない。(20個タブを開いたつもりだったが、実は1個URL以外が含まれていたため19個しか開いていなかった。そのことが検知できない)
・セルを飛んで選択した場合(ctrlを押しながら離れた複数セルを選択)コピーができないので、使用できない。
上記の点が特に問題とならない場合には素直に拡張機能を使った方がいいかなと思います。
イメージ
↓こんな感じでURLの文字列が入ったセルのリストを用意します。
(ハイパーリンクは設定されていなくてもOKです。)
↓実行した場合はこんな感じです。
選択したセルにURL以外が含まれている場合にはメッセージボックスが出力されます。
また、私は作ったマクロをアドインとして保存し、クイックアクセスツールバーに登録して使用しています。
上の図の赤枠部分です。
アドインの登録方法などは以下を参考にしました。
https://excel-ubara.com/excelvba4/EXCEL297.html
コード
OpenBrowsers
'選択範囲のURLをまとめて開く処理
Sub OpenBrowsers()
'選択セル
Dim r As Range
Set r = Selection
'開いたURL数
Dim openCount As Integer
openCount = 0
'開かなかったセルのリスト
Dim not0penList As New Collection
'出力メッセージ
Dim outMsg As String
'選択したセルの数だけループを回す
For Each r2 In r
'===== セルにURL文字列が設定されている場合 =====
If (InStr(r2, "http://") = 1) Or (InStr(r2, "https://") = 1) Then
'セルにハイパーリンクを設定してから開く
ActiveSheet.Hyperlinks.Add(Anchor:=r2, Address:=r2.Value, TextToDisplay:=r2.Value).Follow
'開いたブラウザの数を増やす
openCount = openCount + 1
'===== それ以外 =====
Else
'開かなかったセルのリストに追加する
not0penList.Add r2
End If
Next r2
'===== 開かなかったセルがあった場合にはメッセージを出力 =====
If (not0penList.Count > 0) Then
'何個中何個開いたか
outMsg = outMsg & vbCrLf & openCount & "/" & Selection.Count & "開きました。"
outMsg = outMsg & vbCrLf & "開いていないURLは" & not0penList.Count & "個あります。"
'開いていないセルのセル情報
For Each i In not0penList
outMsg = outMsg & vbCrLf & "[" & i.Address(RowAbsolute:=False, ColumnAbsolute:=False) & "] : " & i
Next i
'メッセージボックスの出力(警告)
MsgBox outMsg, vbExclamation
End If
End Sub
終わり
'選択範囲のURLをまとめて開く処理
Sub OpenBrowsers()
'選択セル
Dim r As Range
Set r = Selection
'開いたURL数
Dim openCount As Integer
openCount = 0
'開かなかったセルのリスト
Dim not0penList As New Collection
'出力メッセージ
Dim outMsg As String
'選択したセルの数だけループを回す
For Each r2 In r
'===== セルにURL文字列が設定されている場合 =====
If (InStr(r2, "http://") = 1) Or (InStr(r2, "https://") = 1) Then
'セルにハイパーリンクを設定してから開く
ActiveSheet.Hyperlinks.Add(Anchor:=r2, Address:=r2.Value, TextToDisplay:=r2.Value).Follow
'開いたブラウザの数を増やす
openCount = openCount + 1
'===== それ以外 =====
Else
'開かなかったセルのリストに追加する
not0penList.Add r2
End If
Next r2
'===== 開かなかったセルがあった場合にはメッセージを出力 =====
If (not0penList.Count > 0) Then
'何個中何個開いたか
outMsg = outMsg & vbCrLf & openCount & "/" & Selection.Count & "開きました。"
outMsg = outMsg & vbCrLf & "開いていないURLは" & not0penList.Count & "個あります。"
'開いていないセルのセル情報
For Each i In not0penList
outMsg = outMsg & vbCrLf & "[" & i.Address(RowAbsolute:=False, ColumnAbsolute:=False) & "] : " & i
Next i
'メッセージボックスの出力(警告)
MsgBox outMsg, vbExclamation
End If
End Sub
今回の処理ではハイパーリンクを設定→開くということを行っているのでブラウザはデフォルトに設定されているものになってしまいます。
開く際にブラウザを選べるようにする機能を追加してもいいかもしれません。
また、他にもVBA用のSeleniumなども使えるようなので、時間があれば調べてみたいと思います。
Author And Source
この問題について(Excelで選択セルのURLを一括で開くマクロ作った), 我々は、より多くの情報をここで見つけました https://qiita.com/mk777/items/7306104530037832b597著者帰属:元の著者の情報は、元のURLに含まれています。著作権は原作者に属する。
Content is automatically searched and collected through network algorithms . If there is a violation . Please contact us . We will adjust (correct author information ,or delete content ) as soon as possible .