참조 설정 목록을 만드는 Excel 매크로

이것은

참조 설정 목록을 만드는 Excel 매크로입니다.

현재 보고 있는 책에 설정된 참조 설정

(설정되지 않은 것을 포함) 모든 참조 설정

의 2 종류를 만들었습니다. (사용법은 잘 모릅니다.)

처리 결과 이미지

설정 중에만

모두

코드

Option Explicit

'* Microsoft Scripting Runtime
'* Microsoft WMI Scripting
'* Microsoft Visual Basic for Applications Extensibility

Dim mWbO As WbemScripting.SWbemObjectEx

Function F() As Excel.WorksheetFunction
    Set F = Excel.WorksheetFunction
End Function

Sub 一覧1()       '全ての参照設定を一覧出力
    Dim dic As Scripting.Dictionary
    Set dic = AllRefs()     '全ての参照設定
    一覧出力 dic
End Sub

Sub 一覧2()       'Bookに設定した参照設定を一覧出力
    Dim dic As Scripting.Dictionary
    Set dic = RefsInBook(Excel.ActiveWorkbook)  'ActiveWorkbookの参照設定
    一覧出力 dic
End Sub

Private Sub 一覧出力(dic As Scripting.Dictionary)
    Dim arr, rng As Excel.Range
    With dic
        arr = F.Transpose(F.Transpose(.Items))
        Set rng = Excel.Workbooks.Add.Worksheets(1).Cells.Resize(UBound(arr, 1), UBound(arr, 2))
    End With
    With rng
        .Value = arr
        .Worksheet.ListObjects.Add xlSrcRange, rng
        .EntireColumn.AutoFit
    End With
End Sub

' '모든 참조 설정'사전 만들기

Function AllRefs() As Scripting.Dictionary
    Const TYPE_LIB = "TypeLib"
    Dim wName, wVer, wGUID, wMajor, wMinor, wArr

    Set AllRefs = CreateObject("Scripting.Dictionary")

    With AllRefs
        For Each wGUID In EnumKey(TYPE_LIB)
            For Each wVer In EnumKey(TYPE_LIB, wGUID)
                DoEvents
                wName = GetStringValue(TYPE_LIB, wGUID, wVer)
             wArr = Split(wVer, ".")
             wMajor = F.Hex2Dec(wArr(0))
             wMinor = F.Hex2Dec(wArr(1))

             .Add Join(Array(wGUID, wMajor, wMinor), vbTab), Array(wName, wGUID, wMajor, wMinor)
            Next wVer
        Next wGUID
    End With
End Function

Function EnumKey(ParamArray k())
    EnumKey = ExecMethod("EnumKey", "sNames", Join(k, "\"))
    If IsNull(EnumKey) Then EnumKey = Array()
End Function

Function GetStringValue(ParamArray k())
    GetStringValue = ExecMethod("GetStringValue", "sValue", Join(k, "\"))
    If IsNull(GetStringValue) Then GetStringValue = vbNullString
End Function

Function ExecMethod(method, prop, subkey) As Variant
    Dim param As WbemScripting.SWbemObjectEx
    With WbO
        Set param = .Methods_(method).InParameters.SpawnInstance_()
        param.Properties_("hDefKey").Value = &H80000000 'HKEY_CLASSES_ROOT
        param.Properties_("sSubKeyName").Value = subkey
        ExecMethod = .ExecMethod_(method, param).Properties_(prop).Value
    End With
End Function

Property Get WbO() As WbemScripting.SWbemObjectEx
    If mWbO Is Nothing Then Set mWbO = CreateObject("WbemScripting.SWbemLocator").ConnectServer(vbNullString, "root\default").Get("StdRegProv")
    Set WbO = mWbO
End Property

' "활성 책에 설정된 참조 설정"사전 만들기

Function RefsInBook(wb As Excel.Workbook) As Scripting.Dictionary
    Dim ref As VBIDE.Reference
    Set RefsInBook = CreateObject("Scripting.Dictionary")
    With RefsInBook
        For Each ref In wb.VBProject.References
            .Add Join(Array(ref.GUID, ref.Major, ref.Minor), vbTab), Array(ref.Description, ref.GUID, ref.Major, ref.Minor)
        Next
    End With
End Function

사전 준비

VBA 프로젝트 모델에 대한 액세스 신뢰
Microsoft Scripting Runtime
Microsoft WMI Scripting
Microsoft Visual Basic for Applications Extensibility