ExcelVBAでディレクトリ階層図作成

ExcelVBAでディレクトリ階層図作成を作成するツールです。Windowsでしか動作確認していないです。
以下のようにシート出力します。新規ブックとして切り離して出力します。
![](https://crossfish.sakura.ne.jp/Images/%E3%83%95%E3%82%A9%E3%83%AB%E3%83%80%E9%9A%8E%E5%B1%A4%E5%9B%B3%E7%94%A8/%E9%9A%8E%E5%B1%A4%E5%9B%B3.png)
### 使い方説明
使い方については、以下の画像を参照してください。
![](https://crossfish.sakura.ne.jp/Images/%E3%83%95%E3%82%A9%E3%83%AB%E3%83%80%E9%9A%8E%E5%B1%A4%E5%9B%B3%E7%94%A8/%E8%AA%AC%E6%98%8E1.png)
![](https://crossfish.sakura.ne.jp/Images/%E3%83%95%E3%82%A9%E3%83%AB%E3%83%80%E9%9A%8E%E5%B1%A4%E5%9B%B3%E7%94%A8/%E8%AA%AC%E6%98%8E2.png)
![](https://crossfish.sakura.ne.jp/Images/%E3%83%95%E3%82%A9%E3%83%AB%E3%83%80%E9%9A%8E%E5%B1%A4%E5%9B%B3%E7%94%A8/%E8%AA%AC%E6%98%8E3.png)
![](https://crossfish.sakura.ne.jp/Images/%E3%83%95%E3%82%A9%E3%83%AB%E3%83%80%E9%9A%8E%E5%B1%A4%E5%9B%B3%E7%94%A8/%E8%AA%AC%E6%98%8E4.png)
![](https://crossfish.sakura.ne.jp/Images/%E3%83%95%E3%82%A9%E3%83%AB%E3%83%80%E9%9A%8E%E5%B1%A4%E5%9B%B3%E7%94%A8/%E8%AA%AC%E6%98%8E5.png)
### 処理の実行
以下のように適当にオブジェクトを作成し、ShowFormのマクロを登録して下さい
![](https://crossfish.sakura.ne.jp/Images/%E3%83%95%E3%82%A9%E3%83%AB%E3%83%80%E9%9A%8E%E5%B1%A4%E5%9B%B3%E7%94%A8/%E3%83%A1%E3%82%A4%E3%83%B3%E7%94%BB%E9%9D%A2.png)
### ユーザーフォームのコントロール名
![](https://crossfish.sakura.ne.jp/Images/%E3%83%95%E3%82%A9%E3%83%AB%E3%83%80%E9%9A%8E%E5%B1%A4%E5%9B%B3%E7%94%A8/%E3%83%95%E3%82%A9%E3%83%BC%E3%83%A0%E3%82%B3%E3%83%B3%E3%83%88%E3%83%AD%E3%83%BC%E3%83%AB.png)
1:   SettingForm
2:   btnSelectFolder
3:   txtTargetFolder
4:   txtPathOutput
5:   txtFolderNameFileNameOutput
6:   txtClassifyOutput
7:   txtSizeOutput
8:   txtLastUpdateOutput
9:   txtClassMapStart
10:  chkSearchSubFolder
11:  chkColoredFolderFile
12:  chkAddHyperLinkToPath
13:  chkExtension1  右隣が2、下が3、24まで
14:  txtExtension1  右隣が2、下が3、24まで
15:  chkNotSpecifyExtension
16:  btnClearExtension
17:  btnExecute
18:  btnClose
### SettingFormのコード
```
Option Explicit

Private Enum SETTING  '各種の固定設定値を格納するEnum
  titleOutputRow = 1           '階層図のタイトル部分を出力する行番号
  classMapOutputFirstRow = 2   '階層図部分を出力する最初の行番号
  coloredLasColumn = 1000
  ' 「フォルダとファイルで色分け」が有効の場合、暫定でセル色を変更する範囲の最後の列番号
  ' この範囲を超えた部分はセル色が変更されないので、大き目の数値で
  maxSpecifyColumn = 100       '「パス」、「フォルダ名・ファイル名」等の出力列指定の最大値
  notOutput = 0                ' 各種設定項目で、無効の場合は0とする
  alertFileAndFolderCount = 50000
  '指定フォルダ以下にある、フォルダ数とファイル数の合計が、この数値以上になったら警告を出す
  maxFolderPathLength = 230    '階層図を作成するフォルダのパスの最大文字数
  maxExtensionLength = 20      '指定する拡張子の最大文字数
End Enum

Private objFSO As FileSystemObject              ' FSO
Private wsJikkou As Worksheet                   ' 「実行」シート
Private wsOutput As Worksheet                   ' 階層図出力シート
Private lngMaxDataColumn As Long                ' データのある最大列
Private lngMaxDataRow As Long                   ' データのある最大行
Private lngCurrentOutputRow As Long             ' 出力シートの現在の出力する行番号
Private strTopFolderPath As String              ' 階層図作成の基点となるフォルダのパス
Private arrExtension() As String                ' 出力するファイルの拡張子を格納する配列

Private lngPathOutputColumn As Long             ' 「パス」を出力する列番号
Private lngNameOutputColumn As Long             ' 「フォルダ名・ファイル名」を出力する列番号
Private lngClassifyOutputColumn As Long         ' 「種別」を出力する列番号
Private lngSizeOutputColumn As Long             ' 「サイズ」を出力する列番号
Private lngLastUpdateOutputColumn As Long       ' 「最終更新日時」を出力する列番号
Private lngClassMapOutputFirstColumn As Long    ' 階層図の作成を始める列番号

Private isSearchSubFolder As Boolean            ' 「サブフォルダも検索する」のフラグ
Private isColoredFolderFile As Boolean                      ' 「フォルダとファイルで色分け」のフラグ
Private isAddHyperLink As Boolean               ' 「パスにハイパーリンクを付与」のフラグ
Private isSpecifyExtension As Boolean            ' 「出力するファイル種別を指定する」のフラグ
Private lngOutputColumnInCaseFolder As Long     ' フォルダの場合の出力列
Private lngOutputColumnInCaseFile As Long       ' ファイルの場合の出力列
Private strSortString As String                 ' パスのソート用文字列
Private lngYenPosition As Long                  ' パスの文字列内の「￥」の位置
Private lngFileCount As Long                    '指定フォルダ以下にある、ファイル数の合計
Private lngFolderCount As Long                  '指定フォルダ以下にある、フォルダ数の合計



' ************  階層図作成処理     ***************************************************************
Private Sub CreateClassMapMain()

  On Error GoTo CreateClassMapMain_ErrorHandler
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  ThisWorkbook.Activate
  
  Call SetupInitialValue   ' 初期値を設定する処理
  
  '入力内容のチェック
  If ValidateInputs = False Then '入力内容に問題があった場合
    Call LastProcess  ' 最終的に実行する処理を呼び出し
    Exit Sub
  End If
  
  
  '指定フォルダ以下にある、フォルダ数とファイル数の合計を取得
  lngFileCount = objFSO.GetFolder(strTopFolderPath).Files.Count  '直下にあるファイル数を取得
  Call GetFileCountAndFolderCount(strTopFolderPath)
  'サブフォルダ以下のフォルダ数、ファイル数を取得する処理を呼び出し
  
  If lngFileCount + lngFolderCount >= SETTING.alertFileAndFolderCount Then
  'フォルダ数とファイル数の合計が既定値以上である場合は、警告を出して処理続行を確認する
    Dim msgResult As VbMsgBoxResult
    msgResult = MsgBox("指定フォルダ以下にある、フォルダ数とファイル数の合計が" _
      & SETTING.alertFileAndFolderCount & "以上になっています" & vbCrLf & _
      "(合計で" & (lngFileCount + lngFolderCount) & "あります)" & vbCrLf & _
      "このまま実行すると途中で処理が中断される可能性があります" & vbCrLf & _
      "続行しますか？", vbYesNo)
    If msgResult = vbNo Then
      MsgBox "処理を中断します"
      Call LastProcess
      Exit Sub
    End If
  End If
  
  
  Call SetupOutputSheet   ' 出力シートのセットアップ処理の呼び出し

  Call FileAndFolderSearch(strTopFolderPath, lngOutputColumnInCaseFolder, lngOutputColumnInCaseFile)
  ' ファイル・フォルダの検索処理を呼び出し
  
  Call AdjustOutputSheet   ' 出力シートの調整処理の呼び出し
  
  Call LastProcess
  階層図作成.Activate
  MsgBox "完了"
  Exit Sub
  
CreateClassMapMain_ErrorHandler:
  If Err.Number <> 514 Then  '他のプロシージャ・関数が再スローしたエラー番号ではない場合
    MsgBox "階層図作成処理でエラーが発生したため、処理を中断します"
  End If
  Call LastProcess   ' 最終的に実行する処理を呼び出し
  Exit Sub
End Sub



' ************  初期値設定処理     ******************************************************************
Private Sub SetupInitialValue()
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set wsJikkou = 階層図作成
  Set wsOutput = Nothing
  lngMaxDataColumn = 1
  lngMaxDataRow = 1
  lngCurrentOutputRow = 1
  strTopFolderPath = ""
  Erase arrExtension
  ReDim arrExtension(0)
  lngPathOutputColumn = SETTING.notOutput
  lngNameOutputColumn = SETTING.notOutput
  lngClassifyOutputColumn = SETTING.notOutput
  lngSizeOutputColumn = SETTING.notOutput
  lngLastUpdateOutputColumn = SETTING.notOutput
  lngClassMapOutputFirstColumn = SETTING.notOutput
  isSearchSubFolder = False
  isColoredFolderFile = False
  isAddHyperLink = False
  isSpecifyExtension = False
  lngOutputColumnInCaseFolder = 1
  lngOutputColumnInCaseFile = 1
  strSortString = ""
  lngYenPosition = 1
  lngFileCount = 0
  lngFolderCount = 0
  
  'サブフォルダも検索するか
  If Me.chkSearchSubFolder.Value Then
    isSearchSubFolder = True
  End If

  'フォルダとファイルで色分けするか
  If Me.chkColoredFolderFile.Value Then
    isColoredFolderFile = True
  End If
  
  'パスにハイパーリンクを付与するか
  If Me.chkAddHyperLinkToPath.Value Then
    isAddHyperLink = True
  End If
  
  '拡張子を限定するか
  If Me.chkNotSpecifyExtension.Value = False Then
    isSpecifyExtension = True
  End If
End Sub



' ************  入力内容のチェック処理     **********************************************************
Private Function ValidateInputs() As Boolean
  Dim arrOutputColumn() As Long    ' 出力列の指定内容を格納する配列
  Dim i As Long
  
  ValidateInputs = True
  ReDim arrOutputColumn(0)
  strTopFolderPath = Me.txtTargetFolder  '階層図を作成するフォルダのパス
  
  If strTopFolderPath = "" Then
    MsgBox "階層図を作成するフォルダの指定がありません"
    ValidateInputs = False
    Exit Function
  End If
  
  If Left(strTopFolderPath, 1) = "." Then
    MsgBox "階層図を作成するフォルダのパスは、「.」で始まるものにしないで下さい"
    ValidateInputs = False
    Exit Function
  End If
  
  If Left(strTopFolderPath, 1) = "\" Then
    MsgBox "階層図を作成するフォルダのパスは、「\」で始まるものにしないで下さい"
    ValidateInputs = False
    Exit Function
  End If
  
  If Left(strTopFolderPath, 1) = "/" Then
    MsgBox "階層図を作成するフォルダのパスは、「/」で始まるものにしないで下さい"
    ValidateInputs = False
    Exit Function
  End If
  
  If Len(strTopFolderPath) > SETTING.maxFolderPathLength Then
    MsgBox "階層図を作成するフォルダのパスは" & SETTING.maxFolderPathLength & "文字までにしてください"
    ValidateInputs = False
    Exit Function
  End If
  
  If objFSO.FolderExists(strTopFolderPath) = False Then
    MsgBox "階層図を作成するフォルダに指定されたフォルダは存在しません"
    ValidateInputs = False
    Exit Function
  Else
    If Right(strTopFolderPath, 1) <> "\" Then  ' パスの最後に￥が無い場合は、￥を付け足す
      strTopFolderPath = strTopFolderPath & "\"
    End If
  End If
  
  If Me.txtPathOutput.Text <> "" Then   '「パス」の出力列の指定がある場合
    If IsNumeric(Me.txtPathOutput.Text) = False Then
      MsgBox "「パス」の出力列の指定は数値にしてください"
      ValidateInputs = False
      Exit Function
    End If
    If Me.txtPathOutput.Text > SETTING.maxSpecifyColumn Then
      MsgBox "「パス」の出力列の指定は" & SETTING.maxSpecifyColumn & "以下にして下さい"
      ValidateInputs = False
      Exit Function
    End If
    If Me.txtPathOutput.Text < 1 Then
      MsgBox "「パス」の出力列の指定は1以上にしてください"
      ValidateInputs = False
      Exit Function
    End If
    lngPathOutputColumn = CLng(WorksheetFunction.RoundDown(CDbl(Me.txtPathOutput.Text), 0))
    arrOutputColumn(UBound(arrOutputColumn)) = lngPathOutputColumn
    ReDim Preserve arrOutputColumn(UBound(arrOutputColumn) + 1)
  End If
  
  If Me.txtFolderNameFileNameOutput.Text <> "" Then   '「フォルダ名・ファイル名」の出力列の指定がある場合
    If IsNumeric(Me.txtFolderNameFileNameOutput.Text) = False Then
      MsgBox "「フォルダ名・ファイル名」の出力列の指定は数値にしてください"
      ValidateInputs = False
      Exit Function
    End If
    If Me.txtFolderNameFileNameOutput.Text > SETTING.maxSpecifyColumn Then
      MsgBox "「フォルダ名・ファイル名」の出力列の指定は" & SETTING.maxSpecifyColumn & "以下にして下さい"
      ValidateInputs = False
      Exit Function
    End If
    If Me.txtFolderNameFileNameOutput.Text < 1 Then
      MsgBox "「フォルダ名・ファイル名」の出力列の指定は1以上にしてください"
      ValidateInputs = False
      Exit Function
    End If
    lngNameOutputColumn = CLng(WorksheetFunction.RoundDown(CDbl(Me.txtFolderNameFileNameOutput.Text), 0))
    arrOutputColumn(UBound(arrOutputColumn)) = lngNameOutputColumn
    ReDim Preserve arrOutputColumn(UBound(arrOutputColumn) + 1)
  End If
  
  If Me.txtClassifyOutput.Text <> "" Then   '「種別」の出力列の指定がある場合
    If IsNumeric(Me.txtClassifyOutput.Text) = False Then
      MsgBox "「種別」の出力列の指定は数値にしてください"
      ValidateInputs = False
      Exit Function
    End If
    If Me.txtClassifyOutput.Text > SETTING.maxSpecifyColumn Then
      MsgBox "「種別」の出力列の指定は" & SETTING.maxSpecifyColumn & "以下にして下さい"
      ValidateInputs = False
      Exit Function
    End If
    If Me.txtClassifyOutput.Text < 1 Then
      MsgBox "「種別」の出力列の指定は1以上にしてください"
      ValidateInputs = False
      Exit Function
    End If
    lngClassifyOutputColumn = CLng(WorksheetFunction.RoundDown(CDbl(Me.txtClassifyOutput.Text), 0))
    arrOutputColumn(UBound(arrOutputColumn)) = lngClassifyOutputColumn
    ReDim Preserve arrOutputColumn(UBound(arrOutputColumn) + 1)
  End If
  
  If Me.txtSizeOutput.Text <> "" Then   '「サイズ」の出力列の指定がある場合
    If IsNumeric(Me.txtSizeOutput.Text) = False Then
      MsgBox "「サイズ」の出力列の指定は数値にしてください"
      ValidateInputs = False
      Exit Function
    End If
    If Me.txtSizeOutput.Text > SETTING.maxSpecifyColumn Then
      MsgBox "「サイズ」の出力列の指定は" & SETTING.maxSpecifyColumn & "以下にして下さい"
      ValidateInputs = False
      Exit Function
    End If
    If Me.txtSizeOutput.Text < 1 Then
      MsgBox "「サイズ」の出力列の指定は1以上にしてください"
      ValidateInputs = False
      Exit Function
    End If
    lngSizeOutputColumn = CLng(WorksheetFunction.RoundDown(CDbl(Me.txtSizeOutput.Text), 0))
    arrOutputColumn(UBound(arrOutputColumn)) = lngSizeOutputColumn
    ReDim Preserve arrOutputColumn(UBound(arrOutputColumn) + 1)
  End If
  
  If Me.txtLastUpdateOutput.Text <> "" Then   '「最終更新日時」の出力列の指定がある場合
    If IsNumeric(Me.txtLastUpdateOutput.Text) = False Then
      MsgBox "「最終更新日時」の出力列の指定は数値にしてください"
      ValidateInputs = False
      Exit Function
    End If
    If Me.txtLastUpdateOutput.Text > SETTING.maxSpecifyColumn Then
      MsgBox "「最終更新日時」の出力列の指定は" & SETTING.maxSpecifyColumn & "以下にして下さい"
      ValidateInputs = False
      Exit Function
    End If
    If Me.txtLastUpdateOutput.Text < 1 Then
      MsgBox "「最終更新日時」の出力列の指定は1以上にしてください"
      ValidateInputs = False
      Exit Function
    End If
    lngLastUpdateOutputColumn = CLng(WorksheetFunction.RoundDown(CDbl(Me.txtLastUpdateOutput.Text), 0))
    arrOutputColumn(UBound(arrOutputColumn)) = lngLastUpdateOutputColumn
    ReDim Preserve arrOutputColumn(UBound(arrOutputColumn) + 1)
  End If
  
  If Me.txtClassMapStart.Text <> "" Then   '「階層図作成開始」の出力列の指定がある場合
    If IsNumeric(Me.txtClassMapStart.Text) = False Then
      MsgBox "「階層図作成開始」の出力列の指定は数値にしてください"
      ValidateInputs = False
      Exit Function
    End If
    If Me.txtClassMapStart.Text > SETTING.maxSpecifyColumn Then
      MsgBox "「階層図作成開始」の出力列の指定は" & SETTING.maxSpecifyColumn & "以下にして下さい"
      ValidateInputs = False
      Exit Function
    End If
    If Me.txtClassMapStart.Text < 1 Then
      MsgBox "「階層図作成開始」の出力列の指定は1以上にしてください"
      ValidateInputs = False
      Exit Function
    End If
    lngClassMapOutputFirstColumn = CLng(WorksheetFunction.RoundDown(CDbl(Me.txtClassMapStart.Text), 0))
    arrOutputColumn(UBound(arrOutputColumn)) = lngClassMapOutputFirstColumn
    ReDim Preserve arrOutputColumn(UBound(arrOutputColumn) + 1)
  End If
  
  If arrOutputColumn(0) = 0 Then
    MsgBox "出力する列の指定が１つもありません"
    ValidateInputs = False
    Exit Function
  End If
  ReDim Preserve arrOutputColumn(UBound(arrOutputColumn) - 1)  ' 最後の要素は削除
  
  If IsOverlapping(arrOutputColumn) Then  '重複をチェックするFunctionを呼び出し
    MsgBox "出力列の指定に重複があります"
    ValidateInputs = False
    Exit Function
  End If
  
  ' 「階層図作成開始」の出力指定列が最も大きいことのチェック
  If lngClassMapOutputFirstColumn <> SETTING.notOutput Then
    If lngPathOutputColumn > lngClassMapOutputFirstColumn Then
      MsgBox "「パス」の出力指定列は「階層図作成開始」の出力指定列よりも小さい数値にしてください"
      ValidateInputs = False
      Exit Function
    End If
    If lngNameOutputColumn > lngClassMapOutputFirstColumn Then
      MsgBox _
      "「フォルダ名・ファイル名」の出力指定列は「階層図作成開始」の出力指定列よりも小さい数値にしてください"
      ValidateInputs = False
      Exit Function
    End If
    If lngClassifyOutputColumn > lngClassMapOutputFirstColumn Then
      MsgBox "「種別」の出力指定列は「階層図作成開始」の出力指定列よりも小さい数値にしてください"
      ValidateInputs = False
      Exit Function
    End If
    If lngSizeOutputColumn > lngClassMapOutputFirstColumn Then
      MsgBox "「サイズ」の出力指定列は「階層図作成開始」の出力指定列よりも小さい数値にしてください"
      ValidateInputs = False
      Exit Function
    End If
    If lngLastUpdateOutputColumn > lngClassMapOutputFirstColumn Then
      MsgBox "「最終更新日時」の出力指定列は「階層図作成開始」の出力指定列よりも小さい数値にしてください"
      ValidateInputs = False
      Exit Function
    End If
  End If

  '拡張子を限定するか
  If Me.chkNotSpecifyExtension Then
    isSpecifyExtension = False
  Else
    isSpecifyExtension = True
  End If
  
  If isSpecifyExtension = True Then
    If SetExtensions = False Then  '指定された拡張子を配列にセットする処理
      MsgBox "有効な拡張子の指定が１つもありません"
      ValidateInputs = False
      Exit Function
    End If
    If IsOverStringLength(arrExtension, SETTING.maxExtensionLength) Then '規定文字数を超える拡張子の指定がある場合
      MsgBox SETTING.maxExtensionLength & "文字を超える拡張子が指定されています。拡張子は" _
       & SETTING.maxExtensionLength & "文字までにしてください"
      ValidateInputs = False
      Exit Function
    End If
    If IsOverlapping(arrExtension) Then  '拡張子配列の要素に重複がある場合
      MsgBox "拡張子の指定に重複があります"
      ValidateInputs = False
      Exit Function
    End If
  End If
End Function


' ************  指定された拡張子を配列にセットする処理     ********************************************
Private Function SetExtensions() As Boolean
  SetExtensions = True
  
  If Me.chkExtension1.Value And Me.txtExtension1.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension1.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If
  If Me.chkExtension2.Value And Me.txtExtension2.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension2.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If
  If Me.chkExtension3.Value And Me.txtExtension3.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension3.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If
  If Me.chkExtension4.Value And Me.txtExtension4.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension4.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If
  If Me.chkExtension5.Value And Me.txtExtension5.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension5.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If
  If Me.chkExtension6.Value And Me.txtExtension6.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension6.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If
  If Me.chkExtension7.Value And Me.txtExtension7.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension7.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If
  If Me.chkExtension8.Value And Me.txtExtension8.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension8.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If
  If Me.chkExtension9.Value And Me.txtExtension9.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension9.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If
  If Me.chkExtension10.Value And Me.txtExtension10.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension10.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If
  If Me.chkExtension11.Value And Me.txtExtension11.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension11.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If
  If Me.chkExtension12.Value And Me.txtExtension12.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension12.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If
  If Me.chkExtension13.Value And Me.txtExtension13.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension13.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If
  If Me.chkExtension14.Value And Me.txtExtension14.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension14.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If
  If Me.chkExtension15.Value And Me.txtExtension15.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension15.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If
  If Me.chkExtension16.Value And Me.txtExtension16.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension16.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If
  If Me.chkExtension17.Value And Me.txtExtension17.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension17.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If
  If Me.chkExtension18.Value And Me.txtExtension18.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension18.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If
  If Me.chkExtension19.Value And Me.txtExtension19.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension19.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If
  If Me.chkExtension20.Value And Me.txtExtension20.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension20.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If
  If Me.chkExtension21.Value And Me.txtExtension21.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension21.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If
  If Me.chkExtension22.Value And Me.txtExtension22.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension22.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If
  If Me.chkExtension23.Value And Me.txtExtension23.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension23.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If
  If Me.chkExtension24.Value And Me.txtExtension24.Value <> "" Then
    arrExtension(UBound(arrExtension)) = Me.txtExtension24.Value
    ReDim Preserve arrExtension(UBound(arrExtension) + 1)
  End If

  If arrExtension(0) = "" Then  '第一要素が空の場合は、何も指定されていない
    SetExtensions = False
    Exit Function
  End If
  
  ReDim Preserve arrExtension(UBound(arrExtension) - 1)  ' 最後の要素は削除
End Function




' ************  指定フォルダ以下にある、フォルダ数とファイル数の合計を取得     ******************************************************************
Private Sub GetFileCountAndFolderCount(ByRef strFolderPath As String)
  Dim folTarget As Folder
  
  On Error GoTo GetFileCountAndFolderCount_ErrorHandler
  For Each folTarget In objFSO.GetFolder(strFolderPath).SubFolders  ' サブフォルダを取得する
    lngFolderCount = lngFolderCount + 1  'フォルダ数をカウントアップ

    If isSearchSubFolder Then  'サブフォルダも検索する場合
      lngFileCount = lngFileCount + objFSO.GetFolder(folTarget.Path).Files.Count  'フォルダ内のファイル数を取得
      Call GetFileCountAndFolderCount(folTarget.Path)  ' 再帰処理でサブフォルダまで検索
    End If
  Next folTarget
  
  Exit Sub
  
GetFileCountAndFolderCount_ErrorHandler:
  MsgBox "指定フォルダ以下にある、フォルダ数とファイル数の合計を取得する処理実行時に" & _
    "エラーが発生したため、処理を中断します"
  Err.Raise 514
  Exit Sub
End Sub



' ************  出力シートのセットアップ処理     ****************************************************
Private Sub SetupOutputSheet()

  ThisWorkbook.Worksheets.Add   ' 新しいシートを追加し、このシートに階層図を作成
  Set wsOutput = ActiveSheet
  wsOutput.Name = "階層図"
  
  With wsOutput  ' 出力シートのタイトル部の設定
    If lngPathOutputColumn <> SETTING.notOutput Then
      .Cells(SETTING.titleOutputRow, lngPathOutputColumn) = "Path"
      .Cells(SETTING.titleOutputRow, lngPathOutputColumn).Interior.Color = RGB(70, 137, 255)
    End If
    If lngNameOutputColumn <> SETTING.notOutput Then
      .Cells(SETTING.titleOutputRow, lngNameOutputColumn) = "フォルダ名／ファイル名"
      .Cells(SETTING.titleOutputRow, lngNameOutputColumn).Interior.Color = RGB(70, 137, 255)
    End If
    If lngClassifyOutputColumn <> SETTING.notOutput Then
      .Cells(SETTING.titleOutputRow, lngClassifyOutputColumn) = "種別"
      .Cells(SETTING.titleOutputRow, lngClassifyOutputColumn).Interior.Color = RGB(70, 137, 255)
    End If
    If lngSizeOutputColumn <> SETTING.notOutput Then
      .Cells(SETTING.titleOutputRow, lngSizeOutputColumn) = "サイズ"
      .Cells(SETTING.titleOutputRow, lngSizeOutputColumn).Interior.Color = RGB(70, 137, 255)
    End If
    If lngLastUpdateOutputColumn <> SETTING.notOutput Then
      .Cells(SETTING.titleOutputRow, lngLastUpdateOutputColumn) = "最終更新日時"
      .Cells(SETTING.titleOutputRow, lngLastUpdateOutputColumn).Interior.Color = RGB(70, 137, 255)
    End If
    If lngClassMapOutputFirstColumn <> SETTING.notOutput Then
      .Cells(SETTING.titleOutputRow, lngClassMapOutputFirstColumn) = "ここから階層図"
      .Cells(SETTING.titleOutputRow, lngClassMapOutputFirstColumn).Interior.Color = RGB(255, 199, 175)
    End If
    
    lngMaxDataColumn = wsOutput.Cells(SETTING.titleOutputRow, wsOutput.Columns.Count).End(xlToLeft).Column
    wsOutput.Range(Cells(SETTING.titleOutputRow, 1), _
      Cells(SETTING.titleOutputRow, lngMaxDataColumn)).Columns.AutoFit   ' セル幅の自動調整
  End With

  ' データのある最終列の変数の設定。階層図部分を出力するかどうかで異なる
  If lngClassMapOutputFirstColumn <> SETTING.notOutput Then  '階層図部分を出力する場合
    lngOutputColumnInCaseFolder = lngClassMapOutputFirstColumn
    lngOutputColumnInCaseFile = lngClassMapOutputFirstColumn + 1
  Else
    lngOutputColumnInCaseFolder = SETTING.notOutput
    lngOutputColumnInCaseFile = SETTING.notOutput
  End If

  lngCurrentOutputRow = SETTING.classMapOutputFirstRow  ' 現在の出力行を設定
End Sub



' ************  ファイル・フォルダの検索処理     *******************************************************
Private Sub FileAndFolderSearch(ByRef strTopFolderPath As String, _
  ByVal lngOutputColumnInCaseFolder As Long, ByVal lngOutputColumnInCaseFile As Long)

  Dim filTarget As File       ' 調査対象となるファイル
  Dim folTarget As Folder     ' 調査対象となるフォルダ
  Dim folSub As Folder    ' サブフォルダ
  Dim i As Long
  Dim isMatchExtension As Boolean     ' ファイルの拡張子が、指定されている拡張子と一致しているか
  
  On Error GoTo FileAndFolderSearch_ErrorHandler
  
  With objFSO
    Set folTarget = .GetFolder(strTopFolderPath)
    If isColoredFolderFile = True Then  ' フォルダとファイルで色分けする場合
      wsOutput.Range(Cells(lngCurrentOutputRow, 1), Cells(lngCurrentOutputRow, SETTING.coloredLasColumn)) _
        .Interior.Color = RGB(204, 255, 255)
    End If

    Call OutputFolderInformation(folTarget, lngOutputColumnInCaseFolder) 'フォルダの情報を出力する処理を呼び出し

    ' フォルダ内のファイルのデータを出力
    For Each filTarget In folTarget.Files
      If isSpecifyExtension = True Then
      ' ファイル種別の指定がある場合
        isMatchExtension = False
        For i = 0 To UBound(arrExtension)
        ' 現在のfilTargetの拡張子が、指定されている拡張子の配列内に存在するかをチェック
          If .GetExtensionName(filTarget) = arrExtension(i) Then
            isMatchExtension = True
            Exit For
          End If
        Next i
        If isMatchExtension = True Then  ' 現在のfilTargetが、指定ファイル種別に該当している場合
          Call OutputFileInformation(filTarget, lngOutputColumnInCaseFile)
          ' ファイルの情報を出力する処理を呼び出し
        End If
      Else  ' ファイル種別の指定が無い場合
          Call OutputFileInformation(filTarget, lngOutputColumnInCaseFile)
          ' ファイルの情報を出力する処理を呼び出し
      End If
    Next filTarget
    
    For Each folSub In folTarget.SubFolders   ' サブフォルダのデータを出力する
      lngCurrentOutputRow = lngCurrentOutputRow + 1
      lngMaxDataRow = lngCurrentOutputRow
    
      If isSearchSubFolder = True Then  ' サブフォルダも検索する場合
        ' ここで自分自身を呼び出す再帰処理。階層図部分を出力するかどうかで、引数の値が変わる
        If lngClassMapOutputFirstColumn <> SETTING.notOutput Then  '階層図部分を出力する場合
          Call FileAndFolderSearch(folSub.Path, lngOutputColumnInCaseFolder + 1, _
            lngOutputColumnInCaseFile + 1)
        Else
          Call FileAndFolderSearch(folSub.Path, lngOutputColumnInCaseFolder, lngOutputColumnInCaseFile)
        End If
      Else  ' サブフォルダは検索しない場合
        If isColoredFolderFile = True Then  ' フォルダとファイルで色分けする場合
          wsOutput.Range(Cells(lngCurrentOutputRow, 1), Cells(lngCurrentOutputRow, SETTING.coloredLasColumn)) _
            .Interior.Color = RGB(204, 255, 255)
        End If
        Call OutputFolderInformation(folSub, lngOutputColumnInCaseFolder + 1) 'フォルダの情報を出力する処理を呼び出し
      End If
    Next folSub
  End With
  
  Exit Sub
  
FileAndFolderSearch_ErrorHandler:
  MsgBox "ファイル・フォルダ検索処理実行時にエラーが発生したため、処理を中断します"
  Err.Raise 514
  Exit Sub
End Sub



' ************  フォルダの情報を出力する処理     ******************************************************
Private Sub OutputFolderInformation(ByRef folTarget As Folder, ByVal lngOutputColumnInCaseFolder As Long)
  With objFSO
    If lngPathOutputColumn <> SETTING.notOutput Then
    'パスを出力する列を設ける場合
      wsOutput.Cells(lngCurrentOutputRow, lngPathOutputColumn) = .GetFolder(folTarget).Path
    End If
    If lngNameOutputColumn <> SETTING.notOutput Then
      wsOutput.Cells(lngCurrentOutputRow, lngNameOutputColumn) = .GetFolder(folTarget).Name
    End If
    If lngClassifyOutputColumn <> SETTING.notOutput Then
      wsOutput.Cells(lngCurrentOutputRow, lngClassifyOutputColumn) = "Folder"
    End If
    If lngSizeOutputColumn <> SETTING.notOutput Then
      wsOutput.Cells(lngCurrentOutputRow, lngSizeOutputColumn) = .GetFolder(folTarget).Size
    End If
    If lngLastUpdateOutputColumn <> SETTING.notOutput Then
      wsOutput.Cells(lngCurrentOutputRow, lngLastUpdateOutputColumn) = .GetFolder(folTarget).DateLastModified
    End If
    If lngClassMapOutputFirstColumn <> SETTING.notOutput Then
      wsOutput.Cells(lngCurrentOutputRow, lngOutputColumnInCaseFolder) = .GetFolder(folTarget).Name
    End If
    If lngMaxDataColumn < lngOutputColumnInCaseFolder Then ' 最大データ列の更新
      lngMaxDataColumn = lngOutputColumnInCaseFolder
    End If
    lngMaxDataRow = lngCurrentOutputRow
  End With
End Sub




' ************  ファイルの情報を出力する処理     ******************************************************
Private Sub OutputFileInformation(ByRef filTarget As File, ByVal lngOutputColumnInCaseFile As Long)
  With objFSO
    lngCurrentOutputRow = lngCurrentOutputRow + 1
    lngMaxDataRow = lngCurrentOutputRow
    
    If isColoredFolderFile = True Then  ' フォルダとファイルで色分けする場合
      wsOutput.Range(Cells(lngCurrentOutputRow, 1), Cells(lngCurrentOutputRow, SETTING.coloredLasColumn)) _
        .Interior.Color = RGB(255, 255, 204)
    End If
    If lngPathOutputColumn <> SETTING.notOutput Then
      wsOutput.Cells(lngCurrentOutputRow, lngPathOutputColumn) = .GetFile(filTarget).Path
    End If
    If lngNameOutputColumn <> SETTING.notOutput Then
      wsOutput.Cells(lngCurrentOutputRow, lngNameOutputColumn) = .GetFile(filTarget).Name
    End If
    If lngClassifyOutputColumn <> SETTING.notOutput Then
      wsOutput.Cells(lngCurrentOutputRow, lngClassifyOutputColumn) = "File"
    End If
    If lngSizeOutputColumn <> SETTING.notOutput Then
      wsOutput.Cells(lngCurrentOutputRow, lngSizeOutputColumn) = .GetFile(filTarget).Size
    End If
    If lngLastUpdateOutputColumn <> SETTING.notOutput Then
      wsOutput.Cells(lngCurrentOutputRow, lngLastUpdateOutputColumn) = _
        .GetFile(filTarget).DateLastModified
    End If
    If lngClassMapOutputFirstColumn <> SETTING.notOutput Then
      wsOutput.Cells(lngCurrentOutputRow, lngOutputColumnInCaseFile) = .GetFile(filTarget).Name
    End If
    If lngMaxDataColumn < lngOutputColumnInCaseFile Then  ' 最大データ列の更新
      lngMaxDataColumn = lngOutputColumnInCaseFile
    End If
  End With
End Sub



' ************  出力シートの調整処理     **********************************************************
Private Sub AdjustOutputSheet()
  Dim i As Long
  
  On Error GoTo AdjustOutputSheet_ErrorHandler
  ' パスのソートをする
  If lngPathOutputColumn <> SETTING.notOutput And lngClassifyOutputColumn <> SETTING.notOutput Then
  ' ソートを実行するのは「パス」と「種別」の出力指定があった場合のみ
    With wsOutput
      .Columns(1).Select
      Selection.Insert   ' ソートのために1列追加
      .Columns(1).NumberFormatLocal = "@"  ' セルの書式設定を文字列に
      
      lngCurrentOutputRow = SETTING.classMapOutputFirstRow
      Do While .Cells(lngCurrentOutputRow, lngPathOutputColumn) <> ""
        .Cells(lngCurrentOutputRow, 1) = .Cells(lngCurrentOutputRow, lngPathOutputColumn + 1)
        strSortString = .Cells(lngCurrentOutputRow, 1)
        If .Cells(lngCurrentOutputRow, lngClassifyOutputColumn + 1) = "File" Then ' 種別がFileだった場合
          lngYenPosition = InStrRev(strSortString, "\")  ' 文字列の後方から「\」を検索
          strSortString = Left(strSortString, lngYenPosition) & " " & _
            Right(strSortString, Len(strSortString) - lngYenPosition)
          ' 最後にある「\」の後に、半角スペースを入れる
          .Cells(lngCurrentOutputRow, 1) = strSortString
        End If
        lngCurrentOutputRow = lngCurrentOutputRow + 1
      Loop
      
      .Range(Cells(SETTING.classMapOutputFirstRow, 1), Cells(lngMaxDataRow, SETTING.coloredLasColumn)). _
        Sort key1:=.Cells(1, 1), MatchCase:=True, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
      ' 加工したパス名を元にソートする
      .Columns(1).Delete ' ソートのために追加した1列目は削除
    End With
  End If

  ' 最終更新日時とサイズ以外の列は、全てセルの書式を文字列にする
  If lngPathOutputColumn <> SETTING.notOutput Then  ' 「パス」の列
    wsOutput.Columns(lngPathOutputColumn).NumberFormatLocal = "@"   ' セルの書式設定を文字列に
  End If
  If lngNameOutputColumn <> SETTING.notOutput Then  '「フォルダ名・ファイル名」の列
    wsOutput.Columns(lngNameOutputColumn).NumberFormatLocal = "@"
  End If
  If lngClassifyOutputColumn <> SETTING.notOutput Then  ' 「種別」の列
    wsOutput.Columns(lngClassifyOutputColumn).NumberFormatLocal = "@"
  End If
  If lngClassMapOutputFirstColumn <> SETTING.notOutput Then  ' 「階層図」の列
    wsOutput.Range(Columns(lngClassMapOutputFirstColumn), Columns(lngMaxDataColumn)) _
      .NumberFormatLocal = "@"
  End If

  ' データの無い部分を全クリア
  wsOutput.Range(Columns(lngMaxDataColumn + 1), Columns(wsOutput.Columns.Count)).Clear
  wsOutput.Range(Rows(lngMaxDataRow + 1), Rows(wsOutput.Rows.Count)).Clear
  
  ' タイトル行で枠固定
  wsOutput.Cells(SETTING.titleOutputRow + 1, 1).Select
  ActiveWindow.FreezePanes = True

  '罫線を設定
  wsOutput.Range(Cells(SETTING.titleOutputRow, 1), Cells(lngMaxDataRow, lngMaxDataColumn)). _
    Borders.LineStyle = True
  
  If isAddHyperLink = True Then  ' パスにハイパーリンクを付与する場合
    If lngPathOutputColumn <> SETTING.notOutput Then
      For i = SETTING.classMapOutputFirstRow To lngMaxDataRow
        wsOutput.Hyperlinks.Add anchor:=wsOutput.Cells(i, lngPathOutputColumn), _
          Address:=wsOutput.Cells(i, lngPathOutputColumn)
      Next i
    End If
  End If
  
  wsOutput.Move  ' 階層図のシートを新規ブックとして切り離し
  Exit Sub
  
AdjustOutputSheet_ErrorHandler:
  MsgBox "出力シートの調整処理でエラーが発生したため、処理を中断します"
  Err.Raise 514
  Exit Sub
End Sub


' ************  配列の要素の文字列長をチェックする    **********************************************************
Function IsOverStringLength(ByRef arrParam() As String, ByVal maxLength As Long) As Boolean
  Dim i As Long
  IsOverStringLength = False

  For i = LBound(arrParam) To UBound(arrParam)
    If Len(arrParam(i)) > maxLength Then
      IsOverStringLength = True
      Exit Function
    End If
  Next i
End Function



' ************  重複をチェックする処理    **********************************************************
Function IsOverlapping(ByRef arrParam) As Boolean
  Dim i As Long
  Dim j As Long
  IsOverlapping = False

  For i = LBound(arrParam) To UBound(arrParam)
    For j = LBound(arrParam) To UBound(arrParam)
      If arrParam(i) = arrParam(j) And i <> j Then
        IsOverlapping = True  '重複があったらTrueに
        Exit For  '重複があったらループを抜ける
      End If
    Next j
    If IsOverlapping Then Exit For
  Next i
End Function


'*************   最後に実行する処理   ***************************************
Private Sub LastProcess()
  Dim ws As Worksheet
  
  '「階層図」シートがこのブック内に残っている場合は、新規ブックとして切り離す
  For Each ws In ThisWorkbook.Worksheets
    If ws.Name = "階層図" Then
      ws.Move
      Exit For
    End If
  Next

  Set objFSO = Nothing
  Set wsJikkou = Nothing
  Set wsOutput = Nothing
  Erase arrExtension
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub



'**********   フォルダ選択のダイアログを開く  *****************************************
Private Sub ShowSelectFolderDialog()
  With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = True Then
      Me.txtTargetFolder = .SelectedItems(1) & "\"
    Else
      MsgBox "キャンセルされました"
    End If
  End With
End Sub








'*********   以下、コントロールのイベント発生時の処理  *******************************

'フォーム初期化時
Private Sub UserForm_Initialize()
  Me.chkNotSpecifyExtension.Value = True
End Sub


'「フォルダ選択」ボタンを押した時
Private Sub btnSelectFolder_Click()
  Call ShowSelectFolderDialog
End Sub


'拡張子のチェックボックス1の値が変化した時
Private Sub chkExtension1_Change()
  If Me.chkExtension1.Value Then
    Me.txtExtension1.Enabled = True
  Else
    Me.txtExtension1.Enabled = False
  End If
End Sub

'拡張子のチェックボックス2の値が変化した時
Private Sub chkExtension2_Change()
  If Me.chkExtension2.Value Then
    Me.txtExtension2.Enabled = True
  Else
    Me.txtExtension2.Enabled = False
  End If
End Sub

'拡張子のチェックボックス3の値が変化した時
Private Sub chkExtension3_Change()
  If Me.chkExtension3.Value Then
    Me.txtExtension3.Enabled = True
  Else
    Me.txtExtension3.Enabled = False
  End If
End Sub

'拡張子のチェックボックス4の値が変化した時
Private Sub chkExtension4_Change()
  If Me.chkExtension4.Value Then
    Me.txtExtension4.Enabled = True
  Else
    Me.txtExtension4.Enabled = False
  End If
End Sub

'拡張子のチェックボックス5の値が変化した時
Private Sub chkExtension5_Change()
  If Me.chkExtension5.Value Then
    Me.txtExtension5.Enabled = True
  Else
    Me.txtExtension5.Enabled = False
  End If
End Sub

'拡張子のチェックボックス6の値が変化した時
Private Sub chkExtension6_Change()
  If Me.chkExtension6.Value Then
    Me.txtExtension6.Enabled = True
  Else
    Me.txtExtension6.Enabled = False
  End If
End Sub

'拡張子のチェックボックス7の値が変化した時
Private Sub chkExtension7_Change()
  If Me.chkExtension7.Value Then
    Me.txtExtension7.Enabled = True
  Else
    Me.txtExtension7.Enabled = False
  End If
End Sub

'拡張子のチェックボックス8の値が変化した時
Private Sub chkExtension8_Change()
  If Me.chkExtension8.Value Then
    Me.txtExtension8.Enabled = True
  Else
    Me.txtExtension8.Enabled = False
  End If
End Sub

'拡張子のチェックボックス9の値が変化した時
Private Sub chkExtension9_Change()
  If Me.chkExtension9.Value Then
    Me.txtExtension9.Enabled = True
  Else
    Me.txtExtension9.Enabled = False
  End If
End Sub

'拡張子のチェックボックス10の値が変化した時
Private Sub chkExtension10_Change()
  If Me.chkExtension10.Value Then
    Me.txtExtension10.Enabled = True
  Else
    Me.txtExtension10.Enabled = False
  End If
End Sub

'拡張子のチェックボックス11の値が変化した時
Private Sub chkExtension11_Change()
  If Me.chkExtension11.Value Then
    Me.txtExtension11.Enabled = True
  Else
    Me.txtExtension11.Enabled = False
  End If
End Sub

'拡張子のチェックボックス12の値が変化した時
Private Sub chkExtension12_Change()
  If Me.chkExtension12.Value Then
    Me.txtExtension12.Enabled = True
  Else
    Me.txtExtension12.Enabled = False
  End If
End Sub

'拡張子のチェックボックス13の値が変化した時
Private Sub chkExtension13_Change()
  If Me.chkExtension13.Value Then
    Me.txtExtension13.Enabled = True
  Else
    Me.txtExtension13.Enabled = False
  End If
End Sub

'拡張子のチェックボックス14の値が変化した時
Private Sub chkExtension14_Change()
  If Me.chkExtension14.Value Then
    Me.txtExtension14.Enabled = True
  Else
    Me.txtExtension14.Enabled = False
  End If
End Sub

'拡張子のチェックボックス15の値が変化した時
Private Sub chkExtension15_Change()
  If Me.chkExtension15.Value Then
    Me.txtExtension15.Enabled = True
  Else
    Me.txtExtension15.Enabled = False
  End If
End Sub

'拡張子のチェックボックス16の値が変化した時
Private Sub chkExtension16_Change()
  If Me.chkExtension16.Value Then
    Me.txtExtension16.Enabled = True
  Else
    Me.txtExtension16.Enabled = False
  End If
End Sub

'拡張子のチェックボックス17の値が変化した時
Private Sub chkExtension17_Change()
  If Me.chkExtension17.Value Then
    Me.txtExtension17.Enabled = True
  Else
    Me.txtExtension17.Enabled = False
  End If
End Sub

'拡張子のチェックボックス18の値が変化した時
Private Sub chkExtension18_Change()
  If Me.chkExtension18.Value Then
    Me.txtExtension18.Enabled = True
  Else
    Me.txtExtension18.Enabled = False
  End If
End Sub

'拡張子のチェックボックス19の値が変化した時
Private Sub chkExtension19_Change()
  If Me.chkExtension19.Value Then
    Me.txtExtension19.Enabled = True
  Else
    Me.txtExtension19.Enabled = False
  End If
End Sub

'拡張子のチェックボックス20の値が変化した時
Private Sub chkExtension20_Change()
  If Me.chkExtension20.Value Then
    Me.txtExtension20.Enabled = True
  Else
    Me.txtExtension20.Enabled = False
  End If
End Sub

'拡張子のチェックボックス21の値が変化した時
Private Sub chkExtension21_Change()
  If Me.chkExtension21.Value Then
    Me.txtExtension21.Enabled = True
  Else
    Me.txtExtension21.Enabled = False
  End If
End Sub

'拡張子のチェックボックス22の値が変化した時
Private Sub chkExtension22_Change()
  If Me.chkExtension22.Value Then
    Me.txtExtension22.Enabled = True
  Else
    Me.txtExtension22.Enabled = False
  End If
End Sub

'拡張子のチェックボックス23の値が変化した時
Private Sub chkExtension23_Change()
  If Me.chkExtension23.Value Then
    Me.txtExtension23.Enabled = True
  Else
    Me.txtExtension23.Enabled = False
  End If
End Sub

'拡張子のチェックボックス24の値が変化した時
Private Sub chkExtension24_Change()
  If Me.chkExtension24.Value Then
    Me.txtExtension24.Enabled = True
  Else
    Me.txtExtension24.Enabled = False
  End If
End Sub

'「拡張子のクリア」ボタンを押した時
Private Sub btnClearExtension_Click()
  Me.txtExtension1.Text = ""
  Me.txtExtension2.Text = ""
  Me.txtExtension3.Text = ""
  Me.txtExtension4.Text = ""
  Me.txtExtension5.Text = ""
  Me.txtExtension6.Text = ""
  Me.txtExtension7.Text = ""
  Me.txtExtension8.Text = ""
  Me.txtExtension9.Text = ""
  Me.txtExtension10.Text = ""
  Me.txtExtension11.Text = ""
  Me.txtExtension12.Text = ""
  Me.txtExtension13.Text = ""
  Me.txtExtension14.Text = ""
  Me.txtExtension15.Text = ""
  Me.txtExtension16.Text = ""
  Me.txtExtension17.Text = ""
  Me.txtExtension18.Text = ""
  Me.txtExtension19.Text = ""
  Me.txtExtension20.Text = ""
  Me.txtExtension21.Text = ""
  Me.txtExtension22.Text = ""
  Me.txtExtension23.Text = ""
  Me.txtExtension24.Text = ""
End Sub


'「拡張子は限定しない」のチェックボックスの値が変化した時
Private Sub chkNotSpecifyExtension_Change()
  If Me.chkNotSpecifyExtension.Value Then
    Me.txtExtension1.Enabled = False
    Me.txtExtension2.Enabled = False
    Me.txtExtension3.Enabled = False
    Me.txtExtension4.Enabled = False
    Me.txtExtension5.Enabled = False
    Me.txtExtension6.Enabled = False
    Me.txtExtension7.Enabled = False
    Me.txtExtension8.Enabled = False
    Me.txtExtension9.Enabled = False
    Me.txtExtension10.Enabled = False
    Me.txtExtension11.Enabled = False
    Me.txtExtension12.Enabled = False
    Me.txtExtension13.Enabled = False
    Me.txtExtension14.Enabled = False
    Me.txtExtension15.Enabled = False
    Me.txtExtension16.Enabled = False
    Me.txtExtension17.Enabled = False
    Me.txtExtension18.Enabled = False
    Me.txtExtension19.Enabled = False
    Me.txtExtension20.Enabled = False
    Me.txtExtension21.Enabled = False
    Me.txtExtension22.Enabled = False
    Me.txtExtension23.Enabled = False
    Me.txtExtension24.Enabled = False
    Me.chkExtension1.Enabled = False
    Me.chkExtension2.Enabled = False
    Me.chkExtension3.Enabled = False
    Me.chkExtension4.Enabled = False
    Me.chkExtension5.Enabled = False
    Me.chkExtension6.Enabled = False
    Me.chkExtension7.Enabled = False
    Me.chkExtension8.Enabled = False
    Me.chkExtension9.Enabled = False
    Me.chkExtension10.Enabled = False
    Me.chkExtension11.Enabled = False
    Me.chkExtension12.Enabled = False
    Me.chkExtension13.Enabled = False
    Me.chkExtension14.Enabled = False
    Me.chkExtension15.Enabled = False
    Me.chkExtension16.Enabled = False
    Me.chkExtension17.Enabled = False
    Me.chkExtension18.Enabled = False
    Me.chkExtension19.Enabled = False
    Me.chkExtension20.Enabled = False
    Me.chkExtension21.Enabled = False
    Me.chkExtension22.Enabled = False
    Me.chkExtension23.Enabled = False
    Me.chkExtension24.Enabled = False
  Else
    Me.chkExtension1.Enabled = True
    Me.chkExtension2.Enabled = True
    Me.chkExtension3.Enabled = True
    Me.chkExtension4.Enabled = True
    Me.chkExtension5.Enabled = True
    Me.chkExtension6.Enabled = True
    Me.chkExtension7.Enabled = True
    Me.chkExtension8.Enabled = True
    Me.chkExtension9.Enabled = True
    Me.chkExtension10.Enabled = True
    Me.chkExtension11.Enabled = True
    Me.chkExtension12.Enabled = True
    Me.chkExtension13.Enabled = True
    Me.chkExtension14.Enabled = True
    Me.chkExtension15.Enabled = True
    Me.chkExtension16.Enabled = True
    Me.chkExtension17.Enabled = True
    Me.chkExtension18.Enabled = True
    Me.chkExtension19.Enabled = True
    Me.chkExtension20.Enabled = True
    Me.chkExtension21.Enabled = True
    Me.chkExtension22.Enabled = True
    Me.chkExtension23.Enabled = True
    Me.chkExtension24.Enabled = True
    If Me.chkExtension1.Value Then
      Me.txtExtension1.Enabled = True
    End If
    If Me.chkExtension2.Value Then
      Me.txtExtension2.Enabled = True
    End If
    If Me.chkExtension3.Value Then
      Me.txtExtension3.Enabled = True
    End If
    If Me.chkExtension4.Value Then
      Me.txtExtension4.Enabled = True
    End If
    If Me.chkExtension5.Value Then
      Me.txtExtension5.Enabled = True
    End If
    If Me.chkExtension6.Value Then
      Me.txtExtension6.Enabled = True
    End If
    If Me.chkExtension7.Value Then
      Me.txtExtension7.Enabled = True
    End If
    If Me.chkExtension8.Value Then
      Me.txtExtension8.Enabled = True
    End If
    If Me.chkExtension9.Value Then
      Me.txtExtension9.Enabled = True
    End If
    If Me.chkExtension10.Value Then
      Me.txtExtension10.Enabled = True
    End If
    If Me.chkExtension11.Value Then
      Me.txtExtension11.Enabled = True
    End If
    If Me.chkExtension12.Value Then
      Me.txtExtension12.Enabled = True
    End If
    If Me.chkExtension13.Value Then
      Me.txtExtension13.Enabled = True
    End If
    If Me.chkExtension14.Value Then
      Me.txtExtension14.Enabled = True
    End If
    If Me.chkExtension15.Value Then
      Me.txtExtension15.Enabled = True
    End If
    If Me.chkExtension16.Value Then
      Me.txtExtension16.Enabled = True
    End If
    If Me.chkExtension17.Value Then
      Me.txtExtension17.Enabled = True
    End If
    If Me.chkExtension18.Value Then
      Me.txtExtension18.Enabled = True
    End If
    If Me.chkExtension19.Value Then
      Me.txtExtension19.Enabled = True
    End If
    If Me.chkExtension20.Value Then
      Me.txtExtension20.Enabled = True
    End If
    If Me.chkExtension21.Value Then
      Me.txtExtension21.Enabled = True
    End If
    If Me.chkExtension22.Value Then
      Me.txtExtension22.Enabled = True
    End If
    If Me.chkExtension23.Value Then
      Me.txtExtension23.Enabled = True
    End If
    If Me.chkExtension24.Value Then
      Me.txtExtension24.Enabled = True
    End If
  End If
End Sub



'「階層図作成実行」ボタンを押した時
Private Sub btnExecute_Click()
  Dim result As VbMsgBoxResult
  result = MsgBox("階層図作成換処理を実行しますか?", vbYesNo)
  If result = vbYes Then
    Call CreateClassMapMain  '階層図作成処理を実行
  Else
    MsgBox "キャンセルされました"
  End If
End Sub


'「閉じる」ボタンを押した時
Private Sub btnClose_Click()
  Me.Hide
End Sub

'フォーム右上の×を押した時
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  If CloseMode = 0 Then
    MsgBox "×ボタンで閉じることはできません"
    Cancel = True
  End If
End Sub
```
### 標準モジュールのコード
```
Option Explicit


'*************  フォームの表示  *************************************
Public Sub ShowForm()
  SettingForm.Show vbModeless
End Sub
```
### ThisWorkbookのコード
```
Option Explicit

Private Sub Workbook_Open()
  Load SettingForm
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Unload SettingForm
End Sub
```
バグなどがありましたら、報告してもらえると助かります。