モジュールエクスポート
アクティブワークブックの全ての標準モジュールをバックアップフォルダにエクスポートします。
マクロでする理由は
  1. モジュールをひとつずつするのが面倒くさい。
  2. ファイル名に日付をつける事により確認しやすいし、二重のバックアップになる。
  3. いったん削除してインポートする事によりファイルのダイエットになる。（特に PERSONAL.XLS）
  4. マクロを PERSONAL.XLS に保存することにより全てのワークブックで使える。
    マクロ名は モジュール削除 は参照。
  5. マクロの実行順は　エクスポート→削除→インポート　となります。
手順は
  1. 参照設定 で「Microsoft Scripting Runtime」にチェックを付けます。
  2. モジュールをエクスポートするフォルダを作ります。　例：D:\My Documents\BkupBAS
  3. ワークブック毎のサブフォルダを作ります。　例：PERSONAL.XLS→「PERSONAL」 HP_01.XLS→「HP_01」
  4. エクスポートされるファイル名は「モジュール名.Bas」となります。
    例：AModuleExport.Bas、AModuleExport_1219.Bas（日付を付加した場合）
  5. 赤字 は環境に合わせて設定する部分です。
VBComponent オブジェクトの Type プロパティの設定値は、次のとおりです。 
  定数                   値  内容
vbext_ct_StdModule        1  標準モジュール
vbext_ct_ClassModule      2  クラス モジュール
vbext_ct_MSForm           3  Microsoft Form
vbext_ct_ActiveXDesigner 11  ActiveX デザイナ
vbext_ct_Document       100  Document モジュール
モジュールエクスポート
Option Explicit

Dim mypBkupPath As String            'BackUp パス名 "D:\My Documents\BAS\"
Dim mypBookA As Workbook

Sub KMoExportCom00()

''Module Export Start           2002/9/4
'    KMoExportCom00

    Dim mypActName As String        'ActiveWorkbook Name
    Dim mypBkupFolder As String     'エクスポートフォルダ名
    
    mypBkupPath = "D:\My Documents\BkupBAS\"
    mypActName = ActiveWorkbook.Name

''エクスポートフォルダ 選択          2002/9/4
    mypBkupFolder = KMoFolderCoice(mypActName)

    mypBkupPath = mypBkupPath & mypBkupFolder & "\"

''モジュールエクスポート 共通1           2002/5/22
    KMoExport01 mypActName

End Sub

Function KMoFolderCoice(mypActName As String)

''エクスポートフォルダ 選択          2002/9/4
'    mypf=KMoFolderCoice( mypActName)

    Dim mypZname As String
    Dim mypZFolder As String
    Dim mypZMsg1 As String
    
    mypZMsg1 = " ] フォルダが設定されていません。"

    If mypActName = "PERSONAL.XLS" Then
        mypZFolder = "Personal"
        KMoFolderCoice = mypZFolder
        Exit Function
    End If
    
    Select Case mypActName
        Case "HP_01.XLS"        'ワークブック名　増やす時は Case を追加する
            mypZFolder = "HP_01"
       
        Case Else
            mypZMsg1 = "[ " & mypZname & mypZMsg1
            MsgBox mypZMsg1, vbCritical
            End
    End Select

    KMoFolderCoice = mypZFolder
    
End Function

Sub KMoExport01(mypBookName As String)

''モジュールエクスポート 共通1           2002/5/22
'    KMoExport01 mypBookName

    Dim myVBAComp As Object
    Dim mypMoName As String            'モジュール名
    Dim mypMoType As Integer           'モジュール型  1:標準 2:Class 3:Form
    Dim mypMoCount As Integer          'モジュール数
    Dim mypTitle As String
    Dim mypMsg1 As String
    Dim mypMsg2 As String
    Dim mypMsg3 As String
    Dim mypRetMsg As Integer
    
    Set mypBookA = Workbooks.Item(mypBookName)
    mypTitle = "Module Export"
    mypMsg1 = "エキスポート終了  "
    mypMsg2 = "ファイル名に日付を付けますか。？  "
    mypMsg1 = mypMsg1 & vbCrLf & vbCrLf & mypBookName & "  [ "
    mypMsg2 = mypMsg2 & vbCrLf & vbCrLf & mypBookName & "   [ "
    
''モジュールエクスポートの確認
    For Each myVBAComp In mypBookA.VBProject.VBComponents
        mypMoType = myVBAComp.Type
        If mypMoType = 1 Then
            mypMoCount = mypMoCount + 1
        End If
    Next
    Beep
    mypMsg3 = mypMsg2 & mypMoCount & " ] → [ "
    mypMsg2 = mypMsg3 & mypBkupPath & " ]"
    mypRetMsg = MsgBox(mypMsg2, vbYesNoCancel + vbQuestion + vbDefaultButton2, mypTitle)
    If mypRetMsg = vbCancel Then
       End
    End If

''モジュールエクスポート
    mypMoCount = 0
    For Each myVBAComp In mypBookA.VBProject.VBComponents
        mypMoType = myVBAComp.Type
        If mypMoType = 1 Then
            mypMoCount = mypMoCount + 1
            mypMoName = myVBAComp.Name

            ''モジュールエクスポート 共通2
            KMoExport02 mypRetMsg, mypMoName
        End If
    Next
    mypMsg1 = mypMsg1 & mypMoCount & " ]"
    MsgBox mypMsg1, vbInformation

End Sub

Sub KMoExport02(mypRetMsg As Integer, mypMoName As String)

''モジュールエクスポート 共通2           2002/5/22
'    KMoExport02 RetMsg,MoName

    Dim mypOutName As String
    Dim myExtName As String
    Dim mypMonth As String
    Dim mypDay As String

    If mypRetMsg = vbYes Then
        mypMonth = Format(Date, "mm")
        mypDay = Format(Date, "dd")
        myExtName = "_" & mypMonth & mypDay & ".Bas"
    ElseIf mypRetMsg = vbNo Then
        myExtName = ".Bas"
    End If
    
    mypOutName = mypBkupPath & mypMoName & myExtName
    mypBookA.VBProject.VBComponents(mypMoName).Export (mypOutName)

End Sub
top