EXCEL VBAのフォームのオブジェクト一覧を自動作成

### VBAフォーム定義
VBAのユーザーフォームの定義表を作成するツールです。
対象のエクセルブックを開きますので、自己責任で注意して使ってください。
IMEモードをコード番号から日本語にしたものを掲載します。
型名順、名前順にソート設定が間違っていたので直しました。
``` vb
.Sort.SortFields.Add Key:= とすべきところを
.Sort.SortFields.Add Keys:=  としていました。
```
このまちがいはコンパイルエラーにも実行時エラーにもならないので困りますね。
### 見当たらないけど一覧表に出るコントロール
著作権の関係で現物を載せられないのですが、あるフォームの定義表をこのツールで作成したら、クリックしても見つからないオプションボタンが出てくるのですが、出来ればDELETEしたいと思います。作り直す以外で何かいい方法があれば教えて下さい。
### 出力例
![form2.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3655346/1e9fc991-6bfd-7ad4-5fa1-af208fd62657.png)



### プログラム
``` vb
Option Explicit

'定数、変数
Const TITLE_ROW = 2
'下記項目の列位置表
Enum F_COL
    左端 = 1
    フォーム名
    型名
    名前
    IMEモード
    キャプション
    可視
    使用可
    ロック
    カラム数
    カラム幅
    使用カラム
    表示カラム
    上位置
    左位置
    高さ
    幅
    タブインデックス
    タブストップ
End Enum
Const MAX_COL = 19

Dim I As Long
Dim bookName As String
Dim outWorkbook As Workbook

'--------------------------------------------------------------------------------
'フォームのコントロールの種類、名前などを新規ブックの各シートに出力（メイン処理）
'--------------------------------------------------------------------------------
Public Sub makeFormDocument()

    '新規ワークブックに出力する
    Set outWorkbook = Workbooks.Add
    '分析対象のワークブックを選択する
    bookName = openVBAFILE
    '選択しなければ終了
    If bookName = "" Then Exit Sub
    
    '各モジュールを分析する
    Dim xlModule As Object
    For Each xlModule In Workbooks(bookName).VBProject.VBComponents
          
        If xlModule.Type = 3 Then
            'ユーザーフォームならオブジェクト定義一覧表を作成する
            Call getFormControls(xlModule)
            
        End If
        
    Next xlModule
    
    If bookName <> ThisWorkbook.Name Then Workbooks(bookName).Close False
    
    Windows(ThisWorkbook.Name).Activate
    Windows(outWorkbook.Name).Activate

End Sub

'------------------------------------------------------------------
'オブジェクト定義一覧表を作成する
'------------------------------------------------------------------
Private Sub getFormControls(ByVal fom As Object)

    Dim myCtrl As Object
    I = TITLE_ROW
    Worksheets.Add after:=ActiveSheet
    outWorkbook.ActiveSheet.Name = fom.Name
    
    With outWorkbook.ActiveSheet
        .Cells(I, F_COL.フォーム名) = "フォーム名"
        .Cells(I, F_COL.型名) = "型名"
        .Cells(I, F_COL.名前) = "名前"
        .Cells(I, F_COL.IMEモード) = "IMEモード"
        .Cells(I, F_COL.キャプション) = "キャプション"
        .Cells(I, F_COL.可視) = "可視"
        .Cells(I, F_COL.使用可) = "使用可"
        .Cells(I, F_COL.ロック) = "ロック"
        .Cells(I, F_COL.カラム数) = "カラム数"
        .Cells(I, F_COL.カラム幅) = "カラム幅"
        .Cells(I, F_COL.使用カラム) = "使用カラム"
        .Cells(I, F_COL.表示カラム) = "表示カラム"
        .Cells(I, F_COL.上位置) = "上位置"
        .Cells(I, F_COL.左位置) = "左位置"
        .Cells(I, F_COL.高さ) = "高さ"
        .Cells(I, F_COL.幅) = "幅"
        .Cells(I, F_COL.タブインデックス) = "タブインデックス"
        .Cells(I, F_COL.タブストップ) = "タブストップ"
    
'    列幅設定
        .Cells(I, F_COL.フォーム名).ColumnWidth = 10
        .Cells(I, F_COL.型名).ColumnWidth = 10
        .Cells(I, F_COL.名前).ColumnWidth = 20
        .Cells(I, F_COL.IMEモード).ColumnWidth = 8
        .Cells(I, F_COL.キャプション).ColumnWidth = 20
        .Cells(I, F_COL.可視).ColumnWidth = 6
        .Cells(I, F_COL.使用可).ColumnWidth = 6
        .Cells(I, F_COL.ロック).ColumnWidth = 6
        .Cells(I, F_COL.カラム数).ColumnWidth = 6
        .Cells(I, F_COL.カラム幅).ColumnWidth = 10
        .Cells(I, F_COL.使用カラム).ColumnWidth = 6
        .Cells(I, F_COL.表示カラム).ColumnWidth = 6
        .Cells(I, F_COL.上位置).ColumnWidth = 6
        .Cells(I, F_COL.左位置).ColumnWidth = 6
        .Cells(I, F_COL.高さ).ColumnWidth = 6
        .Cells(I, F_COL.幅).ColumnWidth = 6
        .Cells(I, F_COL.タブインデックス).ColumnWidth = 6
        .Cells(I, F_COL.タブストップ).ColumnWidth = 6
    
    For Each myCtrl In fom.Designer.Controls
    
        I = I + 1
        
        'Typeによっては、存在しないプロパティもあるのでエラーなら飛ばす
        On Error Resume Next
        
        .Range(.Cells(I, 1), .Cells(I, F_COL.タブストップ)).ClearContents
        
        .Cells(I, F_COL.フォーム名) = fom.Name
        .Cells(I, F_COL.型名) = TypeName(myCtrl)
        .Cells(I, F_COL.名前) = myCtrl.Name
        .Cells(I, F_COL.IMEモード) = fg_imeMode(myCtrl.IMEMode) ' 20241224UPDATE
        .Cells(I, F_COL.キャプション) = myCtrl.Caption
        .Cells(I, F_COL.可視) = myCtrl.Visible
        .Cells(I, F_COL.使用可) = myCtrl.Enabled
        .Cells(I, F_COL.ロック) = myCtrl.Locked
        .Cells(I, F_COL.カラム数) = myCtrl.columncount
        .Cells(I, F_COL.カラム幅) = myCtrl.columnwidths
        .Cells(I, F_COL.使用カラム) = myCtrl.boundcolumn
        .Cells(I, F_COL.表示カラム) = myCtrl.textcolumn
        .Cells(I, F_COL.上位置) = myCtrl.Top
        .Cells(I, F_COL.左位置) = myCtrl.Left
        .Cells(I, F_COL.高さ) = myCtrl.Height
        .Cells(I, F_COL.幅) = myCtrl.Width
        .Cells(I, F_COL.タブインデックス) = myCtrl.tabindex
        .Cells(I, F_COL.タブストップ) = myCtrl.tabstop
    Next
    
    'ソートする（なぜかうまくソートされてない？）
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=.Cells(TITLE_ROW, F_COL.型名), Order:=xlAscending
    .Sort.SortFields.Add Key:=.Cells(TITLE_ROW, F_COL.名前), Order:=xlAscending
    .Sort.SetRange .Range(.Cells(TITLE_ROW, F_COL.左端), .Cells(I, F_COL.タブストップ))
    .Sort.Header = xlYes
    .Sort.Apply
    
    'オートフィルター設定
    .Range("B2").AutoFilter
    
    'ウインドウ枠固定
    Range("E3").Select
    ActiveWindow.FreezePanes = True
    '項目名は折り返し表示
    .Range(Cells(TITLE_ROW, 1), Cells(TITLE_ROW, MAX_COL)).WrapText = True
    '縮小表示
    .Range(Cells(TITLE_ROW + 1, 2), Cells(I, 3)).ShrinkToFit = True
    '折り返し表示
    .Range(Cells(TITLE_ROW + 1, 4), Cells(I, MAX_COL)).WrapText = True
    '罫線を引く
   .Range(Cells(TITLE_ROW, 2), Cells(I, MAX_COL)).Borders.LineStyle = xlContinuous
   'タイトル設定
   .Cells(1, 3).Value = bookName & "(" & Format(Now, "YYYY/MM/DD") & ")"
    '印刷範囲設定
   .PageSetup.PrintArea = .Range(Cells(1, 2), Cells(I, MAX_COL)).Address
    
   End With

End Sub

'------------------------------------------------------------------
'対象ファイルをオープンしてファイル名を返す
'------------------------------------------------------------------
Private Function openVBAFILE() As String

    Dim targetFileName As String
    
    targetFileName = Application.GetOpenFilename("マクロ有効　EXCELブック, *.xlsm")
    If targetFileName = "False" Then Exit Function
    
    Application.EnableEvents = False
    Workbooks.Open targetFileName, ReadOnly:=True
    Application.EnableEvents = True
    
    If Not (ActiveWindow Is Nothing) Then
        ActiveWindow.Visible = False
    End If
    openVBAFILE = Mid(targetFileName, InStrRev(targetFileName, "\") + 1)
 
End Function

```
### IMEモードを日本語化
MEモードをコード番号から日本語にしたものを掲載します。
``` vb
'------------------------------------------------------------------
'IMEモード（数字）を日本語にして返す
'------------------------------------------------------------------
Private Function fg_imeMode(ByVal ime As String) As String

    If IsNull(ime) Then
          fg_imeMode = ""
          Exit Function
    End If
    
    Select Case ime
        Case "0"
           fg_imeMode = "制御なし"
        Case "1"
          fg_imeMode = "オン"
        Case "2"
          fg_imeMode = "オフ英語モード"
        Case "3"
          fg_imeMode = "使用不可"
        Case "4"
          fg_imeMode = "全角ひらがな"
        Case "5"
          fg_imeMode = "全角カタカナカタカナ"
        Case "6"
          fg_imeMode = "半角カタカナ"
        Case "7"
          fg_imeMode = "全角英数字"
        Case "8"
          fg_imeMode = "半角英数字"
        Case Else
           fg_imeMode = ""
    End Select
 
End Function
```
### 出力例
![IMEJapan.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3655346/df1d4358-5285-ee3a-01be-7d69dd71e0e7.png)