参照設定の一覧を作るExcelマクロ

### これは

参照設定の一覧を作るExcelマクロです。

* 現在表示中のブックに設定済みの参照設定
* （設定していないものも含む）全ての参照設定

の２種類を作りました。（使い道は、よく分かりません。）

### 処理結果イメージ
* 設定中のみ
![reflist2.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/164214/8eafc6b2-1d53-702f-0e32-dd65f2f8287e.png)

* 全て
![reflist.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/164214/b403add6-cb43-faf7-c85f-67b800d86c58.png)

###コード
```vb
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
```

```vb


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

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

```vb
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
```

' :one: 「全ての参照設定」の辞書を作る

```vb
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
```
```vb

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
```

' :two: 「アクティブなブックに設定されている参照設定」の辞書を作る

```vb

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
```

### 事前準備
:white_check_mark:　 VBAプロジェクトモデルへのアクセスを信頼する
:white_check_mark:　 Microsoft Scripting Runtime
:white_check_mark:　 Microsoft WMI Scripting
:white_check_mark:　 Microsoft Visual Basic for Applications Extensibility