ユーザー定義関数でハイパーリンクのURLを取得（Hyperlink）

公開日：2013年5月以前　最終更新日：2020-08-26

ユーザー定義関数でハイパーリンクのURLを取得（Hyperlink）

ネットから、何らかの一覧をエクセルにコピペすると、

文字列や画像等に、リンクの設定がくっついてきます。

URLが表記されていれば良いですが、表示されていない事の方が多いでしょう。

そこで、VBAでユーザー定義関数を作成し、URLを取得できるようにします。

A1は、文字にURLのリンクが設定されています。

A2は、画像にURLのリンクが設定されています。

A3は、文字と画像にURLのリンクが設定されています。

A4は、文字にメールアドレスのリンクが設定されています。

B列は、以下のユーザー定義関数を設定しました。

=GetHyperlink(A1)

A2以下にも同様の関数を設定しました。

以下が、ユーザー定義関数になります。




Function GetHyperlink(セル As Range) As String
　　　　Dim sp As 
Shape
　　　　If セル.Hyperlinks.Count > 0 Then

      　　　　　　　　GetHyperlink = セル.Hyperlinks(1).Address
　　　　End If
　　　　For Each sp In 
ActiveSheet.Shapes
　　　　　　　　If セル.Address = sp.TopLeftCell.Address 
Then
　　　　　　　　　　　　GetHyperlink = GetHyperlink & vbLf & 
sp.Hyperlink.Address
　　　　　　　　End If
　　　　Next
End 
Function

標準モジュールに作成して下さい。

説明

Dim sp As Shape
図形オブシェクトの変数定義です。

セル.Hyperlinks.Count
セルに含まれるハイパーリンクがあるかの判定です。

For Each sp In ActiveSheet.Shapes
現在シートの図形コレクションから１つづつ取り出します。

sp.TopLeftCell
図形の左上のセルを取得します。

つまり、図形の左上が、当該セルに含まれているかを判定しています。

全体が入っているかの判定をしてしまうと、漏れが発生します。

逆に、一部が含まれているかの判定では、重複が発生します。

左上での判定が、最も見た目の間隔に近いと思います。

セル.Hyperlinks(1).Address
sp.Hyperlink.Address
URLを文字列で取得します。

複数のハイパーリンクが１つのセルに含まれる場合は、（複数図形等）

改行コードで結合しています。

セルの書式を、「折り返して全体を表示」に設定して下さい。

注意．
セルは、Hyperlinks(1)
図形は、Hyperlink
です。

この違いを理解するには、CellsがRangeオブジェクトである事を理解する必要があります。

Rangeオブジェクトは、セル範囲ですので、Hyperlinkのコレクションになります。

コレクションですから、インデックスを指定します。

この場合は、１つのセル範囲なので、(1)しか存在しません。

図形は、指定された図形１つだけですので、Hyperlinkになります。

上のRangeオブシェクトの話が理解できない場合は、

RangeとCellsの深遠 を参考にして下さい。

RangeとCells特集にします。今さら…と、あなどるなかれ、結構奥が深いのです。すでに説明した内容もありますが、知っておいた方が良い事、知らなくても困らない事（笑）これらを、まとめてみました。まずは基本 A1セルに"エクセル"と入れる場合。

ただ、結構難しい解説となっています。

できれば、ExcelマクロVBA入門 を順序良く読んで下さい。

・VBA学習の進め方について・1. VBAの基礎・基本：VBA入門・2. VBA入門に必要なVBEの基本的使い方・3. VBAプログラミングの基礎・基本・4. Excel各種機能とオブジェクトの理解：VBA入門・5. VBA初級からVBA中級を目指して・6. VBA入門の後日追加記事・7. VBA入門その後の学習について・「VBA入門」の記事を学校の授業もしくは企業研修でお使いになる場合

少しVBAが解る方は、

For～Next等で処理し、値のみをセルに入れた方が、使い勝手は良いと思います。

例えば以下のように。




Sub GetHyperlink2()
　　Dim i As Long, iMax As Long
　　Dim strUrl As 
String
　　iMax = Cells(Rows.Count, 1).End(xlUp).Row
　　For i = 1 To 
iMax
　　　　strUrl = ""
　　　　If Cells(i, 1).Hyperlinks.Count > 0 
Then
　　　　　　strUrl = Cells(i, 1).Hyperlinks(1).Address
　　　　End 
If
　　　　For Each sp In ActiveSheet.Shapes
　　　　　　If Cells(i, 1).Address = 
sp.TopLeftCell.Address Then
　　　　　　　　strUrl = strUrl & vbLf & 
sp.Hyperlink.Address
　　　　　　End If
　　　　Next
　　　　If Not IsEmpty(strUrl) 
Then
　　　　　　Cells(i, 2) = strUrl
　　　　End If
　　Next
End 
Sub

少し面倒ですね。

セル内に、左上が入っている図形を簡単に取得できれば良いのですが、

現在、私には解りません。（多分無理かなと思っています。）

従って、シート内の図形を全て検索し、当該セルに含まれるかの判定をしています。

注意．
前回は、Do～Loopを使用しました。
今回は、For～Nextを使用しています。
特段の理由はありません。
同じ事をするにも、いろいろなVBAコードがある事の紹介にすぎません。

ネットからコピーして、資料等を作成する場合には、使う機会があると思います。

ユーザー定義関数の実践使用例

ユーザー定義関数の作り方

・簡単な例でユーザー定義関数を作ってみましょう・この関数の使い方・ユーザー定義関数の実践使用例

ユーザー定義関数でフリガナを取得する（GetPhonetic）

ワークシート関数の、「PHONETIC」では、他のソフト等からコピペした漢字は取得できません。そこで、VBAでユーザー定義関数を作成し、読みを取得できるようにします。A列はメモ帳よりコピペしました。B列に、ユーザー定義関数を指定して、振り仮名を取得しています。

スピルに対応したXSPLITユーザー定義関数（文字区切り）

・区切り位置ウィザード・ワークシートの関数で文字区切りする場合・ユーザー定義関数のVBAｺｰﾄﾞ・XSPLIT関数の使用例・ユーザー定義関数の実践使用例

スピルと新関数の練習（XLOOKUP関数、LET関数、VBAまで）

・スピルとXLOOKUP関数の練習問題・従来の関数+スピルで数式を作る・ XLOOKUP関数に書き換える・LET関数に書き換える・VBAでユーザー定義関数を作成・スピルと新関数の練習のまとめ

同じテーマ「マクロVBAサンプル集」の記事

ユーザー定義関数でフリガナを取得する（GetPhonetic）

ユーザー定義関数でハイパーリンクのURLを取得（Hyperlink）
カラーのコード取得（256RGB⇔16進変換）

・カラーのコード取得のシートレイアウト・カラーのコード取得のVBAコード・カラーのコード取得の解説

時刻になったら音を鳴らして知らせる（OnTime）

・作成するシート・標準モジュールのVBAコード・VBAコードの解説・ビープ音を変更したい場合・時刻になったら音を鳴らして知らせる最後に

指定文字、指定数式でジャンプ機能（Union）

・ジャンプのセル選択以外でセルを選択するには・指定文字、指定数式でジャンプ機能のVBA ・指定文字、指定数式でジャンプ機能の解説・指定文字、指定数式でジャンプ機能の最後に

「値の貼り付け」をショートカットに登録（OnKey）

コピーペーストの質問で、よく目にするのは、値の貼り付けが面倒だというものです。どうも、ショートカットが無いからのようです。ネットを調べて見たのですが、どれもしっくりこないので、作ってみました。いろいろな方法が考えられるのですが、簡単かつ直ぐに使えて、他の人にも配布可能なものが良いと思います。

「セルの結合」をショートカットに登録（OnKey）

「値の貼り付け」をショートカットに登録が好評だったので（本当かな）、その第二弾！セルの結合をショートカットに登録します。作り方は、前回の、「値の貼り付け」をショートカットに登録と同様です。コピーペーストの質問で、よく目にするのは、値の貼り付けが面倒だというものです。

半角カナのみ全角カナに変換する

半角カナのみ全角カナに変換します。ネットを探してみたところ、あるにはあるのですが、どうも中途半端。直ぐに使えて、汎用性のあるプログラムが見つからなかったので、作ってみました。ではプログラムです。PrivateSub半角カナto全角カナ(ByRefobjRangeAsRange)DimstrInAs String'元…

計算式の元となる数値定数を消去する（Precedents）

指定のセルの計算式が参照しているセルの数値定数をクリアします。ただし、参照しているセルが、さらに他のセルを参照している場合は、その先のセルを消去します。つまり、計算式の入っているセルを起点にして、その参照先をすべて検索し、計算式の元となるセル（数値定数が入っているセル）の値をクリアします。

Beep音で音楽（Beep,Sleep）

時々検索されるので、Beep音で音楽を演奏してみましょう。プログラムはほぼAPIをCALLするだけです。まずは、シートです。こんな感じです。ドレミの周波数は結構適当なので、詳しい方は自分で調整して下さい。

日付の検索（配列の使用）

日付の検索は、いろいろと面倒です。Findメソッドで検索する場合、表示書式に左右されますので、表示書式を変更しただけで、検索されなくなります。これは、手作業での検索においても同様になりますが、マクロとしてはいかにも不便です。

アクセスランキング・・・ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.RangeとCellsの使い方｜VBA入門
4.ひらがな⇔カタカナの変換｜エクセル基本操作
5.繰り返し処理（For Next)｜VBA入門
6.変数宣言のDimとデータ型｜VBA入門
7.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
8.並べ替え（Sort）｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.Findメソッド（Find,FindNext,FindPrevious）｜VBA入門

ホーム
マクロVBA応用編
マクロVBAサンプル集
ユーザー定義関数でハイパーリンクのURLを取得（Hyperlink）

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。

VBAサンプル集
ユーザー定義関数でハイパーリンクのURLを取得（Hyperlink）