§２　　 ビジネステクノロジー活用講座

■ExcelVBAのソースコードを可視化/一覧化する

最近のExcelはこれがExcelか！と思うほど、強力な開発機能を備えています。しかし、他に人が作成したExcelVBAは解読や修正が 困難な場合が多々あります。
Sheetや共通モジュール、フォームに散在するVBAソースを１つのExcelシート上にまとめれば、解析も容易。 あとはExcelの機能でExcelVBAを可視化、解析が簡単にできます。
以下のような解析画面はその下に添付したVBAソースをそのまま使用すれば、すぐに作成できます。

☆動かない場合にはお気軽にお問い合わせください☆

ExcelVBAをExportしたフォルダ

Excelに取り込んで作成したソースファイル一覧

Excel上の全VBAソースコード表示

Excelのフィルタ機能やVBAで作成した関数レベルの一覧表

【ExcelVBA可視化プログラム・ソース】

'
'  ソースをExportするプログラムです。解析したいExcelシートのどこかに貼り付けて実行すれば、
'  そのカレントフォルダに\sourceフォルダが作成され、そのフォルダ下にVBAソースがExportされます。
'
Private Sub CommandButton1_Click()
    Dim TempComponent As Object
    Dim ExportPath As String
 
    'Export先フォルダの作成、存在すればデータをクリアー
    ExportPath = ThisWorkbook.Path & "\source"
    If Dir(ExportPath, vbDirectory) = "" Then
      Call MkDir(ExportPath)
    End If
    '
    If Dir(ExportPath & "\BAS", vbDirectory) = "" Then
      Call MkDir(ExportPath & "\bas")
    Else
      Kill ExportPath & "\bas\*.*"
    End If
    '
    If Dir(ExportPath & "\CLS", vbDirectory) = "" Then
      Call MkDir(ExportPath & "\cls")
    Else
      Kill ExportPath & "\cls\*.*"
    End If
    '
    If Dir(ExportPath & "\FRM", vbDirectory) = "" Then
      Call MkDir(ExportPath & "\frm")
    Else
      Kill ExportPath & "\frm\*.*"
    End If
 
    'プロジェクト内全ソースコードをExport
    For Each TempComponent In ThisWorkbook.VBProject.VBComponents
        Select Case TempComponent.Type
          Case 1    '標準モジュール
            TempComponent.Export ExportPath & "\bas\" & TempComponent.Name & ".bas"
          Case 2    'クラスモジュール
            TempComponent.Export ExportPath & "\cls\" & TempComponent.Name & ".cls"
          Case 3    'ユーザーフォーム
            TempComponent.Export ExportPath & "\frm\" & TempComponent.Name & ".frm"
          Case 100  'Excelオブジェクト（ワークブック・シート）
            TempComponent.Export ExportPath & "\cls\" & TempComponent.Name & ".cls"
        End Select
    Next
    MsgBox "Export完了"
End Sub


'
'  上記のExportデータを一括してExcelシートに読込み、関数一覧などを作成するVBAです。
'
Dim out_ctr As Long

'全ソース読込み
Private Sub CommandButton1_Click()
    Dim foldername As String
    Dim i As Long
    Dim x, y As String
    Dim buff As String
            
    out_ctr = 0
    Worksheets("Sheet1").Cells.ClearContents
    Worksheets("Sheet2").Cells.ClearContents
      
    foldername = GetFoldername("c:\")
    If foldername <> "" Then
      Call getFileList(foldername)
      
      out_ctr = 1
      i = 1
      Do Until Worksheets("Sheet1").Cells(i, 1) = ""
        x = Worksheets("sheet1").Cells(i, 2)
        j = InStrRev(x, ".")
        y = StrConv(Mid(x, j, 10), vbLowerCase)
        If y = ".bas" Or y = ".cls" Or y = ".frm" Then
          Open Worksheets("Sheet1").Cells(i, 1) & "\" & Worksheets("Sheet1").Cells(i, 2) For Input As #1
          num = 0
          Do Until EOF(1)
            Line Input #1, buff
            num = num + 1
            y = StrConv(buff, vbLowerCase)
            'If InStr(1, y, "function ") > 0 And InStr(1, y, "end function") < 1 Or _
            '   InStr(1, y, "sub ") > 0 And (InStr(1, y, "end sub") < 1 Or InStr(1, y, "exit sub") < 1) Then

              Worksheets("Sheet2").Cells(out_ctr, 1) = Worksheets("sheet1").Cells(i, 1)
              Worksheets("Sheet2").Cells(out_ctr, 2) = Worksheets("sheet1").Cells(i, 2)
              Worksheets("Sheet2").Cells(out_ctr, 3) = buff
              Worksheets("Sheet2").Cells(out_ctr, 4) = num

              out_ctr = out_ctr + 1
            
             'End If
            
          Loop
          Close #1
        End If
        i = i + 1
      Loop
    End If
    
End Sub

'ファイル一覧作成
Sub getFileList(DirPath As String)
    Dim buff As String, fl As Object
    buff = Dir(DirPath & "\*.*")
    Do While buff <> ""
        out_ctr = out_ctr + 1
        Cells(out_ctr, 1) = DirPath
        Cells(out_ctr, 2) = buff
        buff = Dir()
    Loop
    With CreateObject("Scripting.FileSystemObject")
        For Each fl In .GetFolder(DirPath).SubFolders
            Call getFileList(fl.Path)
        Next fl
    End With
End Sub


'フォルダ選択
Function GetFoldername(pathname) As String
Dim FN As String
With Application.FileDialog(msoFileDialogFolderPicker)
  .InitialFileName = pathname
  If .Show = -1 Then
    FN = .SelectedItems(1)
  Else
    FN = ""
  End If
End With
GetFoldername = FN
End Function

Excelシートに取り込めば、あとはExcelの検索やフィルタ機能、さらにはVBAを使えば本格的なプログラム解析まで簡単に可能です。 システムエンジニアの手作業に依存せず、エンジニアよりも安く、早く、正確に作業が可能です。ぜひお試しください。