Excel 個人用マクロブックでハイパーリンクを抽出する方法とその問題解決

Excel で複数のシートにまたがるハイパーリンクを一覧化したいと考えたことはありませんか？本記事では、個人用マクロブック（PERSONAL.XLSB）を活用して、新しいブックでもハイパーリンクを抽出できるマクロを作成する方法を解説します。

ただし、実際にマクロを実行したところ、新しいブックで実行してもシートが追加されない問題が発生しました。その原因を探り、適切な修正を施したマクロを紹介します。

本記事を読めば、Excel のマクロを活用したハイパーリンク抽出の仕組みと、個人用マクロブックを使う際の落とし穴を理解できるようになります。

個人用マクロブックとは？

個人用マクロブック（PERSONAL.XLSB）は、Excel を開くたびに自動的に読み込まれる特殊なマクロブックです。通常の Excel ファイルとは異なり、どのブックを開いていても使用できるマクロを保存できるため、定型作業を自動化するのに便利です。

個人用マクロブックにマクロを保存すると、新しいブックを開いた際にも同じマクロを呼び出せるため、ハイパーリンクの抽出作業をどのブックでも実行できます。

ハイパーリンクを抽出するマクロの作成

マクロの目的

本マクロの目的は、アクティブなシート内に存在するセルのハイパーリンクおよびオブジェクト（図形など）に埋め込まれたハイパーリンクを抽出し、新しいシートに一覧化することです。

問題発生

作成したマクロを個人用マクロブックに保存し、新しい Excel ファイルで実行しました。しかし、「すべてのハイパーリンクを抽出しました！」とメッセージは表示されるものの、新しいシートが作成されないという問題が発生しました。

原因の特定

マクロ内の ThisWorkbook.Sheets.Add(After:=ws) の部分に注目すると、

• ThisWorkbook は「マクロが保存されているブック（PERSONAL.XLSB）」を指す
• そのため、新しいシートが新規の Excel ブックではなく、個人用マクロブックに追加されていた

これが、実行したブックには何も変化がないように見えた原因でした。

解決策

ThisWorkbook の代わりに ActiveWorkbook を使用することで、現在開いている Excel ブック（マクロ実行元のブック）に新しいシートを追加するように変更しました。

Sub ExtractAllHyperlinks()
    Dim ws As Worksheet
    Dim linkSheet As Worksheet
    Dim cell As Range
    Dim shape As Shape
    Dim rowNum As Integer
    Dim sheetName As String
    Dim i As Integer

    ' アクティブシートを設定
    Set ws = ActiveSheet

    ' 既存の "Extracted_Hyperlinks" シートの有無をチェック
    sheetName = "Extracted_Hyperlinks"
    i = 1
    Do While SheetExists(sheetName, ws.Parent)
        sheetName = "Extracted_Hyperlinks_" & i
        i = i + 1
    Loop

    ' 新しいシートをアクティブなブックに追加
    Set linkSheet = ws.Parent.Sheets.Add(After:=ws)
    linkSheet.Name = sheetName

    ' ヘッダーを追加
    linkSheet.Cells(1, 1).Value = "種類"
    linkSheet.Cells(1, 2).Value = "リンク先"
    linkSheet.Cells(1, 3).Value = "対象"
    rowNum = 2

    ' セルのハイパーリンクを取得
    For Each cell In ws.UsedRange
        If cell.Hyperlinks.Count > 0 Then
            linkSheet.Cells(rowNum, 1).Value = "セル"
            linkSheet.Cells(rowNum, 2).Value = cell.Hyperlinks(1).Address
            linkSheet.Cells(rowNum, 3).Value = cell.Value
            rowNum = rowNum + 1
        End If
    Next cell

    ' オブジェクトのハイパーリンクを取得
    For Each shape In ws.Shapes
        If shape.Hyperlink.Address <> "" Then
            linkSheet.Cells(rowNum, 1).Value = "オブジェクト"
            linkSheet.Cells(rowNum, 2).Value = shape.Hyperlink.Address
            linkSheet.Cells(rowNum, 3).Value = shape.Name
            rowNum = rowNum + 1
        End If
    Next shape

    ' メッセージ表示
    MsgBox "すべてのハイパーリンクを抽出しました！", vbInformation
End Sub

' シートの存在を確認する関数
Function SheetExists(sheetName As String, wb As Workbook) As Boolean
    Dim ws As Worksheet
    SheetExists = False
    For Each ws In wb.Sheets
        If ws.Name = sheetName Then
            SheetExists = True
            Exit Function
        End If
    Next ws
End Function

まとめ

本記事では、Excel の個人用マクロブックを利用したハイパーリンク抽出マクロを作成し、その過程で発生した「シートが作成されない問題」の原因と解決策を解説しました。

個人用マクロブックを使用する際には、ThisWorkbook の使用に注意し、実際に影響を与えたいブックがどこなのかを意識することが重要です。