Excelマクロブックの全モジュール、シート内コードのエクスポートマクロ

個人的備忘録マクロ。
選択したExcelマクロブック(.xlsm)の全てのモジュール内のコードを同階層にフォルダを作ってエクスポートするやつ。
使用するためにはセキュリティーセンターかトラストセンターの「マクロの設定」で「VBA プロジェクトオブジェクトモデルへの信頼アクセスを許可する」にチェックを入れる必要あり。
重大なセキュリティ上の考慮事項を書いておくと、常時この設定を有効化していると危険性があるので、今回提示するマクロを使用する毎に設定のチェックON/OFFを切り替えることを強く推奨する。※もしこの意味が分からない人は絶対に使わないで
なんでこういうの作ったかというとWinMergeとかで差分比較する時に便利だから。めんどくさいからChatGPTに書かせて動作検証は最低限。当方は動作の一切の責任を負いません。
以上。


Option Explicit

Public Sub ExportVBAFromSelectedWorkbook()
    Dim fd As FileDialog
    Dim targetPath As String
    Dim targetWorkbook As Workbook
    Dim vbComp As Object
    Dim exportFolder As String
    Dim fileNameNoExt As String

    ' VBAプロジェクトへのアクセスを許可しているか確認
    If Application.VBE.ActiveVBProject.Protection = 1 Then
        MsgBox "VBAプロジェクトへのアクセスが制限されています。" & vbCrLf & _
               "セキュリティセンターで『VBAプロジェクト オブジェクトモデルへの信頼アクセス』を有効にしてください。", vbCritical
        Exit Sub
    End If

    ' ファイル選択ダイアログ
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Title = "エクスポートするマクロ付きExcelファイルを選択"
        .Filters.Clear
        .Filters.Add "Excel Macro-Enabled Workbook", "*.xlsm"
        .AllowMultiSelect = False

        If .Show <> -1 Then Exit Sub ' キャンセルされたら終了

        targetPath = .SelectedItems(1)
    End With

    Application.ScreenUpdating = False

    ' ブックを非表示で開く（自動マクロなどがあれば注意）
    Set targetWorkbook = Workbooks.Open(Filename:=targetPath, ReadOnly:=True)

    ' エクスポートフォルダ（同じ場所）
    fileNameNoExt = Left(Dir(targetPath), InStrRev(Dir(targetPath), ".") - 1)
    exportFolder = Left(targetPath, InStrRev(targetPath, "\")) & fileNameNoExt & "_VBAコード出力\"
    
    If Dir(exportFolder, vbDirectory) = "" Then
        MkDir exportFolder
    End If

    ' モジュールごとに書き出し
    For Each vbComp In targetWorkbook.VBProject.VBComponents
        Select Case vbComp.Type
            Case 1 ' 標準モジュール
                vbComp.Export exportFolder & vbComp.Name & ".bas"
            Case 2, 100 ' クラス or ThisWorkbook/Sheet
                vbComp.Export exportFolder & vbComp.Name & ".cls"
            Case 3 ' フォーム
                vbComp.Export exportFolder & vbComp.Name & ".frm"
        End Select
    Next vbComp

    targetWorkbook.Close SaveChanges:=False

    Application.ScreenUpdating = True
    MsgBox "エクスポート完了：" & vbCrLf & exportFolder, vbInformation
End Sub

関連投稿: