CheckDependencies

' CheckDependencies
' -----------------
' Macro Name: CheckDependencies
' Description: VBAプロジェクトの名前参照設定の依存関係を確認する
' Parameters: なし
' Returns: なし
' Usage: 実行すると参照設定の参照先リストとステータスがシートに出力される
' -----------------

Sub CheckDependencies()
    Dim vbProj As Object
    Dim ref As Object
    Dim ws As Worksheet
    Dim outputRow As Long
    Dim missingCount As Long
    Dim brokenList As String

    On Error GoTo ErrorHandler

    On Error Resume Next
    Set vbProj = ActiveWorkbook.VBProject.References
    On Error GoTo ErrorHandler
    If vbProj Is Nothing Then
        MsgBox "この操作には VBA プロジェクトへのアクセス許可が必要です。", vbCritical
        Exit Sub
    End If

    Set ws = ActiveSheet
    outputRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    If outputRow < 1 Then outputRow = 1
    outputRow = outputRow + 2

    ws.Cells(outputRow, 1).Value = "VBA 参照設定一覧"
    ws.Cells(outputRow, 1).Font.Bold = True
    ws.Cells(outputRow, 1).Font.Size = 14
    outputRow = outputRow + 1

    ws.Cells(outputRow, 1).Value = "名前"
    ws.Cells(outputRow, 2).Value = "バージョン"
    ws.Cells(outputRow, 3).Value = "状態"
    ws.Cells(outputRow, 1).Font.Bold = True
    ws.Cells(outputRow, 2).Font.Bold = True
    ws.Cells(outputRow, 3).Font.Bold = True
    ws.Range(ws.Cells(outputRow, 1), ws.Cells(outputRow, 3)).Interior.Color = RGB(200, 200, 200)
    outputRow = outputRow + 1

    missingCount = 0
    brokenList = ""

    For Each ref In ActiveWorkbook.VBProject.References
        Dim refName As String
        Dim refVer As String
        refName = ref.Name
        refVer = ref.Major & "." & ref.Minor & "." & ref.Build

        If ref.IsBroken Then
            ws.Cells(outputRow, 1).Value = refName
            ws.Cells(outputRow, 2).Value = refVer
            ws.Cells(outputRow, 3).Value = "参照不可"
            ws.Cells(outputRow, 3).Font.Color = RGB(255, 0, 0)
            ws.Cells(outputRow, 1).Interior.Color = RGB(255, 230, 230)
            ws.Cells(outputRow, 2).Interior.Color = RGB(255, 230, 230)
            ws.Cells(outputRow, 3).Interior.Color = RGB(255, 230, 230)
            missingCount = missingCount + 1
            brokenList = brokenList & "  - " & refName & vbCrLf
        Else
            ws.Cells(outputRow, 1).Value = refName
            ws.Cells(outputRow, 2).Value = refVer
            ws.Cells(outputRow, 3).Value = "OK"
            ws.Cells(outputRow, 3).Font.Color = RGB(0, 128, 0)
        End If
        outputRow = outputRow + 1
    Next ref

    ws.Columns("A:C").AutoFit

    If missingCount > 0 Then
        MsgBox "参照設定チェック完了。" & vbCrLf & missingCount & " 件の参照不可が見つかりました。" & vbCrLf & vbCrLf & brokenList, vbExclamation
    Else
        MsgBox "参照設定チェック完了。問題なし。", vbInformation
    End If
    Exit Sub

ErrorHandler:
    If Err.Number = 9 Then
        MsgBox "この操作には VBA プロジェクトへのアクセス許可が必要です。" & vbCrLf & "ツール > 参照設定を確認してください。", vbCritical
    Else
        MsgBox "エラーが発生しました: " & Err.Description, vbCritical
    End If
End Sub