ExcelVBAのソースコードを一括で抽出

いらすとや_Excel VBA

Excelでマクロ書いたらモジュール全部コミットしておく様に指示されて、「え?モジュール100個超えてんじゃん」って事で、ソースコードを抽出するマクロを書きました。

汎用性とか考えていないので、PERSONAL.XLSBとして動作する事しか見ていません。

開いているExcelファイルと同ディレクトリーに「Export」フォルダーを作成して、その中にファイルを保存します。


コード

Option Explicit

Const DIR_NAME_EXPORT = "Export"

Const EXT_TYPE_MODULE = 1
Const EXT_TYPE_CLASS = 2
Const EXT_TYPE_FORM = 3
Const EXT_TYPE_DOCUMENT = 100

Const EXT_MODULE = ".bas"
Const EXT_CLASS = ".cls"
Const EXT_FORM = ".frm"
Const EXT_DOCUMENT = ".vbd"

' ------------------------------------------------------------
' Excel VBAのソースコードをエクスポート
' ------------------------------------------------------------
Sub ExportSourdeCode()
    Dim module                  As Variant
    Dim module_array            As Variant
    Dim ext                     As String
    Dim dir_full_path           As String
    Dim dir_full_path_export    As String
    Dim file_full_path_export   As String
    
    ' カレントディレクトリーの取得
    dir_full_path = ActiveWorkbook.Path
    ' ディレクトリーパスの取得
    dir_full_path_export = dir_full_path & "\" & DIR_NAME_EXPORT

    ' ディレクトリー作成
    If Dir(dir_full_path_export, vbDirectory) = "" Then
        MkDir dir_full_path_export
    End If

    ' ブックのモジュール一覧を取得
    Set module_array = ActiveWorkbook.VBProject.VBComponents

    For Each module In module_array
        Select Case module.Type
            ' 標準モジュール
            Case EXT_TYPE_MODULE
                ext = EXT_MODULE
            ' クラス
            Case EXT_TYPE_CLASS
                ext = EXT_CLASS
            ' フォーム
            Case EXT_TYPE_FORM
                ' ".frx"も一緒にエクスポートされる
                ext = EXT_TYPE_FORM
            ' Microsoft Visual Basic Activex Document
            Case EXT_TYPE_DOCUMENT
                ext = EXT_DOCUMENT
            ' その他
            Case Else
                GoTo CONTINUE
        End Select
        
        ' エクスポート実行
        file_full_path_export = dir_full_path_export & "\" & module.Name & ext
        Call module.Export(file_full_path_export)

CONTINUE:
    Next

    MsgBox "エクスポート完了"
End Sub

コメント

タイトルとURLをコピーしました