[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『シート内のハイパーリンクのリンク切れをチェックできるボタンを作りたい』(mochiko)
Sheet1とSheet2の複数のセルにPC内のファイルに飛ぶハイパーリンクを貼っているのですが、ファイルが削除されていたり、ファイル名が微妙に変わっていたりでリンク切れに気付かない場合があります。
そこで、マクロボタンを押したらリンク切れをチェックできるようにしたいです。
リンク切れを発見した場合の処理は、そのハイパーリンクのセルの文字列をウィンドウで表示出来たらと考えています。
マクロは勉強し始めたばかりで、とっかかりがない状態で恐縮ですが、ご教示いただければ幸いです。
< 使用 Excel:Excel2016、使用 OS:Windows10 >
アクティブシートのなかのハイパーリンクのリンク先を取得して、 イミディエイトウインドウに出力するには、以下のようにします。 Sub test() Dim hl As Hyperlink For Each hl In ActiveSheet.Hyperlinks Debug.Print hl.Address Next End Sub
これを参考にして、以下の手順で考えたらどうですか? (1)そのリンク先(パス名)に対して、Dir関数をあてて、 fname = Dir(hl.Address) その結果としてファイル名が返るはずですが、リンク切れなら "" が返るはずです。 これで判断できるはずです。 (2) そのリンクのある場所は、hl.Range.Address(external:=true) で分かりますので、 それを使って、Debug.Print なりで、イミディエイトウインドウにでも出力すればよいかと。 (3)この作業を、ブックの各シートに対して実行します。 For Each ws In workSheets 上記の処理 Next トライしてみてください。
(γ) 2022/01/29(土) 08:40
返信ありがとうございます。
やるべきことが大分整理できました。
ただ、相対パスのせいかフルパス取得が上手くいきません。
Dドライブにあるファイルにリンクしているのに、なぜか取得したパスが「c:\ユーザー名\Document\リンクのファイル名」になったりします。その上、そのパスでハイパーリンクが上書きされてしまいます。
絶対パスにすれば問題ないようですが、人に渡すこともあるので絶対パスにするわけにもいかず。
ThisWorkbook.Pathが使えれば解決する気もしていますが、私の知識では上手くいきません。
解決方法があれば教えて頂ければ幸いです。
(mochiko) 2022/01/29(土) 16:17
参考情報を追加しておきます。
ハイパーリンクを挿入する際、「ハイパーリンクの基点」を指定したうえで、 リンク先を指定することがあります。
この「ハイパーリンクの基点」を確認するには、次のようにします。 ・「ファイル」-「情報」をクリックしてください。 ・その画面の右下にある「すべてのプロパティを表示」をクリックします。 ・プロパティのなかに「ハイパーリンクの基点」というのがあります。確認してください。
そして、 ・もし「ハイパーリンクの基点」が設定されている状態では、 これを基点として、ファイルの相対指定をもとに、絶対指定のパス名に変換されます。 Dir(基点のパス & "\" & ファイル名)を調べることで、リンクが切れているかが チェックできるはずです。 ・指定がなければ、カレントフォルダを基点とした相対指定とみなされます。 Dir関数もフォルダを指定しなければ、カレントフォルダが前提となりますから、 単純に Dir(フォルダなしのファイル名)で存在チェックができると思います。
(γ) 2022/01/29(土) 17:19
度々、ありがとうございます。
ハイパーリンクの起点は指定されておりませんでした。
しかし、アドバイスからふと思いついて、Excelのオプションを見直したところ、
保存の「既定でコンピューターに保存する」はチェックが外れた状態になっていたものの、
その中の項目の「既定のローカルファイルの保存場所」が先述のパスになっておりました。
この設定のパスを削除したところ、正常にファイル名のみを取得できるようになり、
望んだ処理になりました。
ありがとうございました。
(mochiko) 2022/01/29(土) 17:51
解決ということだったでしょうか?
あなたのお話は、こういうことですか? ・パスを指定せずにファイル名だけを指定してハイパーリンクを設定したとき、 ・Application.DefaultFilePath にセットされているパスが補われて、 ・そのフルパスにジャンプした、 ということですか? 確認しましたけど、私の手元ではそういう動作にはならなかったですね。 # 解決されたのならよいのですが、個人的には釈然としませんでした。 ---------- ■私の発言に間違いがありましたので訂正します。 CurDirをつけて、Dir関数の結果を見ると書きましたが、それは間違い。 Dir(ThisWorkBook.Path & "\" & hl.address) を調べてみてください。
---------- ■別アプローチの紹介。
色々なオプションが関係するようなので、実際にリンクを実行させてみて結果で判断という方法も 別アプローチとしてあるでしょう。 その場合は、こんなコードになります。 ・ジャンプできなかったリンクの、リンク元アドレスとリンク先ファイルを イミディエイトウインドウに出力します。
Sub main() Dim ws As Worksheet Dim hl As Hyperlink Dim adr As String
Application.ScreenUpdating = False For Each ws In Worksheets For Each hl In ws.Hyperlinks On Error Resume Next hl.Follow ' ハイパーリンクの実行 If Err.Number <> 0 Then ' エラーが起きたら adr = hl.Range.Address(external:=True) Debug.Print "リンク切れ" Debug.Print " リンク元アドレス "; adr Debug.Print " リンク先ファイル "; hl.Address Err.Clear End If On Error GoTo 0 Next Next Application.ScreenUpdating = True End Sub
難点は対象ファイルが開いたままになることです。 もしリンクファイルがExcelであれば、例えば次のような方法を使って、 Excelブックを自動的に閉じることができます。 Excel以外は手で閉じることになるでしょうか。
<<標準モジュール>> Option Explicit
Public numOfBooks As Long '■追加 Sub main() Dim ws As Worksheet Dim hl As Hyperlink Dim adr As String
numOfBooks = Workbooks.Count '■追加 Application.ScreenUpdating = False ■以下同じにつき省略。
<<ThisWorkbookモジュール>>'■追加 Option Explicit
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink) Dim wb As Workbook If Workbooks.Count > numOfBooks Then Set wb = Workbooks(Workbooks.Count) wb.Close End If End Sub (γ) 2022/01/30(日) 09:01
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.