マクロエクスポートインポート／実装処理

Attribute VB_Name = "実装処理"
Option Explicit

' ---------------------------------------------------------------------------------------------------------------------
' 定数（共通）
' ---------------------------------------------------------------------------------------------------------------------

' タイトル名（共通）
Public Const TITLE_NAME_BY_TARGET_DIR = "▼処理対象ディレクトリ"
Public Const TITLE_NAME_BY_DO_SUB_DIR = "▼配下のディレクトリも対象"

' 雛形シートコピー用（共通）
Public Const TEMPLATE_SHEET_NAME = "雛形"
Public Const RESULT_SHEET_NAME = "処理結果"

' 対象の拡張子
Public Const FILE_EXTENSION = "xls,xlsx,xlsm"

' ---------------------------------------------------------------------------------------------------------------------
' 定数（個別）
' ---------------------------------------------------------------------------------------------------------------------

' タイトル文字列（対象シート固有）
Private Const TITLE_▼一括エクスポート先 = "▼一括エクスポート先"
Private Const TITLE_▼一括インポート元 = "▼一括インポート元"

' ルートディレクトリ（末端）
Private Const ROOT_DIR_NAME = "EXPORT"

' オプションボタン名リスト
Private Const オプション名_処理区分名リスト = "エクスポート,インポート"

' 処理結果シートデータ貼付け部の列数
Private Const RESULT_COL_LENGTH = 3

' ---------------------------------------------------------------------------------------------------------------------
' 変数
' ---------------------------------------------------------------------------------------------------------------------

' タイトル文字列（対象シート固有）

' 検索文言リスト
Private TITLE_▼一括エクスポート先List As Variant
Private TITLE_▼一括インポート元List As Variant

' 処理した件数
Dim resultCount As Long

' 処理日時
Public 処理日時 As String

' オプションボタン取得用
Private オプションボタンリスト As Variant
' オプションボタン取得値の保持用
Public Type optionButtonSelectedName
    value As String
End Type

Private 処理区分値名 As optionButtonSelectedName

Private ファイルCLOSE方法全ブック対象確認済フラグ As Boolean
Private ファイルCLOSE方法確認結果 As Long


' #####################################################################################################################
' #
' # テンプレートメソッド(テンプレート処理から呼び出されるメソッド）
' #
' # 1. 全体前処理()            処理実行前に1度だけ実行したい処理を実装する
' # 2. ブックOPEN後処理()      検出されたファイルのブックごとに行いたい処理を実装する
' #                            （シート毎の処理呼び出しが不要かの判定値(boolean)を返却する）
' # 3. シート毎処理()          検出されたファイルの1シートごとに行いたい処理を実装する
' # 4. ブックCLOSE前処理()     検出されたファイルのブックごとに行いたい後処理を実装する
' # 5. 実行結果内容編集処理()  実行結果について、ファイルに出力する前に編集したい場合に実装する（重複の削除、ソート等）
' # 6. 実行結果書式編集処理()  ファイルに出力した後の実行結果を編集したい場合に実装する（ハイパーリンクの設定等）
' # 7. 全体後処理()            処理実行後に1度だけ実行したい処理を実装する
' #
' #####################################################################################################################
'

' *********************************************************************************************************************
' 機能　：固有処理側の前処理
' *********************************************************************************************************************
'
Function 全体前処理(targetSheet As Worksheet)

    ' -----------------------------------------------------------------------------------------------------------------
    ' 初期化処理
    ' -----------------------------------------------------------------------------------------------------------------

    ' 処理した件数の初期化
    resultCount = 0
    ファイルCLOSE方法全ブック対象確認済フラグ = False

    ' -----------------------------------------------------------------------------------------------------------------
    ' 前処理
    ' -----------------------------------------------------------------------------------------------------------------

    ' 処理対象の検索文言リストを取得する。
    
    ' タイトル「▼保存先」の入力値を取得する。
    TITLE_▼一括エクスポート先List = タイトル名指定でリスト値を取得(TITLE_▼一括エクスポート先, targetSheet)
    TITLE_▼一括インポート元List = タイトル名指定でリスト値を取得(TITLE_▼一括インポート元, targetSheet)
    
    ' 処理日時の取得
    処理日時 = Format(Date, "yyyymmdd") & Format(Time, "hhnnss")
    
    ' オートシェイプ（オプションボタン）情報を取得。
    オプションボタンリスト = getShapesProperty(targetSheet, msoFormControl, xlOptionButton)
    
    ' 取得したオプションボタンリストを、処理区分値名を保持
    ' 対象の要素数を取得
    Dim 対象オプションボタンリスト() As Variant
    Dim 処理区分値リスト(2) As String
    Dim i, j, k, count As Long
    Dim リスト名() As String
    リスト名 = Split(オプション名_処理区分名リスト, ",")
    
    ' 対象オプションボタン情報の取得
    count = 0
    For i = LBound(オプションボタンリスト) To UBound(オプションボタンリスト)
        For j = LBound(リスト名) To UBound(リスト名)
            If オプションボタンリスト(i, 1) = リスト名(j) Then
                count = count + 1
            End If
        Next j
    Next i
    
    ' 取得した要素数で配列作成&対象のリスト値を設定
    ReDim Preserve 対象オプションボタンリスト(count - 1, UBound(オプションボタンリスト, 2) + 1)
    count = 0
    For i = LBound(オプションボタンリスト) To UBound(オプションボタンリスト)
        For j = LBound(リスト名) To UBound(リスト名)
            If オプションボタンリスト(i, 1) = リスト名(j) Then

                ' 結果保持配列の作成
                For k = LBound(オプションボタンリスト, 2) To UBound(オプションボタンリスト, 2)
                    対象オプションボタンリスト(count, k) = オプションボタンリスト(i, k)
                Next k
                count = count + 1
            End If
        Next j
    Next i
    
    ' オプションボタン名の取得
    For i = LBound(オプションボタンリスト) To UBound(オプションボタンリスト)
        If オプションボタンリスト(i, 2) = 1 Then
            処理区分値名.value = オプションボタンリスト(i, 1)
        End If
    Next i
    
End Function

' *********************************************************************************************************************
' 機能　：検出されたファイルのブックごとに行いたい処理を実装する（シート毎の処理呼び出しが不要かの判定値(boolean)を返却する）
' *********************************************************************************************************************
'
Function ブックOPEN後処理(fileName As Variant, targetWB As Workbook, ByRef results() As Variant) As Boolean

    ' 処理対象ディレクトリ情報
    Dim ルートパス, 相対パス, ブック名 As String
    Dim ファイル操作情報 As ファイル操作情報
    
    ' モジュールファイル名の拡張子情報
    Dim fileExtention As Variant
    fileExtention = Split(FILE_EXTENSION_OF_MODULE, ",")
    
    ' 対象のモジュールファイル名取得
    Dim moduleFileNames() As String
    Dim moduleFileName As Variant
    
    ' ファイル操作情報
    Dim ファイル情報 As ファイル操作情報
    Dim モジュールファイル情報 As ファイル操作情報
        
    ' -----------------------------------------------------------------------------------------------------------------
    ' 処理
    ' -----------------------------------------------------------------------------------------------------------------

    ' 処理対象のファイル操作情報の取得
    ファイル情報 = ファイル操作情報の取得(fileName)
    
    相対パス = ファイル情報.分割ファイル情報(0)
    ブック名 = targetWB.Name
    
    If 処理区分値名.value = "エクスポート" Then
    
        ' 指定された、エクスポート先ディレクトリの存在確認
        If 0 > isDirectoryExist(CStr(TITLE_▼一括エクスポート先List(0))) Then
            MsgBox "入力欄「▼一括エクスポート先」で指定したディレクトリが存在しません。処理を中断します。"
            End
        End If
        
        ' ルートパスの設定
        ルートパス = TITLE_▼一括エクスポート先List(0) & PATH_DELIMITER & ROOT_DIR_NAME
        
        ' ルートパスのディレクトリを作成する。
        Call ディレクトリ作成(ルートパス, 処理日時, "")
        
        ' 相対パスのディレクトリを作成する。
        Call ディレクトリ作成(ルートパス, 処理日時, 相対パス)
        
        ' モジュールを一括エクスポートする。
        Call ExportModules(ルートパス & 処理日時 & PATH_DELIMITER & 相対パス & PATH_DELIMITER, targetWB)
        
        ' エクスポート後の出力ファイル情報を取得する
        Call doRepeat(ルートパス & 処理日時 & PATH_DELIMITER & 相対パス & PATH_DELIMITER, fileExtention, moduleFileNames, True)
        
        ' 結果を格納する
        If 0 < IsArrayEx(moduleFileNames) Then
            For Each moduleFileName In moduleFileNames
                ' ファイル操作情報の取得
                モジュールファイル情報 = ファイル操作情報の取得(moduleFileName)
                ' 取得結果を設定
                Call reDimResult(RESULT_COL_LENGTH, results)                                  ' 結果保持配列の作成
                results(0, resultCount) = モジュールファイル情報.親ディレクトリまでのフルパス ' 対象ディレクトリ
                results(1, resultCount) = ファイル情報.対象ファイル名                         ' 対象ファイル名
                results(2, resultCount) = モジュールファイル情報.対象ファイル名               ' 対象モジュール名
                resultCount = resultCount + 1
            Next
        End If
        
    ElseIf 処理区分値名.value = "インポート" Then
    
        ' 指定された、インポート先ディレクトリの存在確認
        If 0 > isDirectoryExist(CStr(TITLE_▼一括インポート元List(0))) Then
            MsgBox "入力欄「▼一括エクスポート元」で指定したディレクトリが存在しません。処理を中断します。"
            End
        End If
        
        ' ルートパスの設定
        ルートパス = TITLE_▼一括インポート元List(0)
        
        ' 現在のディレクトリ配列のファイル名の取得
        Call doRepeat(ルートパス, fileExtention, moduleFileNames, True)
        
        ' ルートディレクトリ配下に、処理対象のexcelファイルのディレクトリ名があった場合
        ' そのディレクトリ配下のモジュールの入れ替えを行う。
        Dim ファイルパス As String
        
        ファイル情報 = ファイル操作情報の取得(fileName)
        
        ' 対象ファイル内のモジュールを一括削除する
        Call DeleteComponents(targetWB)
        
        For Each moduleFileName In moduleFileNames
            モジュールファイル情報 = ファイル操作情報の取得(moduleFileName)
            
            If モジュールファイル情報.対象ディレクトリ名 = ファイル情報.分割ファイル情報(0) Then
                ' 対象ファイルに対象モジュールをインポートする。
                Call ImportComponents(targetWB, モジュールファイル情報.フルパス_ファイル名, モジュールファイル情報.分割ファイル情報(0))
                
                ' 取得結果を設定
                Call reDimResult(RESULT_COL_LENGTH, results)                     ' 結果保持配列の作成
                results(0, resultCount) = ファイル情報.フルパス                  ' 対象ディレクトリ
                results(1, resultCount) = ファイル情報.対象ファイル名            ' 対象ファイル名
                results(2, resultCount) = モジュールファイル情報.対象ファイル名  ' 対象モジュール名
                resultCount = resultCount + 1
            End If
        Next
    End If
            
    ' 戻り値の設定
    ブックOPEN後処理 = True

End Function

' *********************************************************************************************************************
' 機能　：検出されたファイルの1シートごとに行いたい処理を実装する
' *********************************************************************************************************************
'
Function シート毎処理(fileName As Variant, targetSheet As Worksheet, ByRef results() As Variant)

    
End Function

' *********************************************************************************************************************
' 機能　：検出されたファイルのブックごとに行いたい後処理を実装する
' *********************************************************************************************************************
'
Function ブックCLOSE前処理(fileName As Variant, targetWB As Workbook, ByRef results() As Variant) As Long
    Dim lng確認結果 As Long
    Dim txt確認メッセージ(0) As String
    
    If 処理区分値名.value = "エクスポート" Then
        ファイルCLOSE方法確認結果 = ファイルCLOSE方法区分.保存しないで閉じる
        
    ElseIf 処理区分値名.value = "インポート" Then
        If ファイルCLOSE方法全ブック対象確認済フラグ = False Then
            txt確認メッセージ(0) = "ファイルを保存して閉じてよろしいですか？"
            lng確認結果 = 確認ダイアログ表示(txt確認メッセージ, False)
            
            If lng確認結果 = vbYes Then
                ファイルCLOSE方法確認結果 = ファイルCLOSE方法区分.保存して閉じる
                
                txt確認メッセージ(0) = "ファイルを保存して閉じる設定を、全処理対象ファイルに適用しますか？"
                lng確認結果 = 確認ダイアログ表示(txt確認メッセージ, False)
                If lng確認結果 = vbYes Then
                    ' 全ファイル保存して閉じる設定を確認済とする
                    ファイルCLOSE方法全ブック対象確認済フラグ = True
                End If
                
            ElseIf lng確認結果 = vbNo Then
                ファイルCLOSE方法確認結果 = ファイルCLOSE方法区分.保存しないで閉じない
                    
                txt確認メッセージ(0) = "ファイルを保存せずに開いておく設定を、全処理対象ファイルに適用しますか？"
                lng確認結果 = 確認ダイアログ表示(txt確認メッセージ, False)
                
                If lng確認結果 = vbYes Then
                    ' 全ファイル保存せずに開いたままの設定を確認済とする
                    ファイルCLOSE方法全ブック対象確認済フラグ = True
                End If
            End If
        End If
    End If
    
    ブックCLOSE前処理 = ファイルCLOSE方法確認結果

End Function

' *********************************************************************************************************************
' 機能　：実行結果について、ファイルに出力する前に編集したい場合に実装する（重複の削除、ソート等）
' *********************************************************************************************************************
'
Function 実行結果内容編集処理(ByRef var変換元() As Variant) As Variant

End Function

' *********************************************************************************************************************
' 機能　：ファイルに出力した後の実行結果を編集したい場合に実装する（ハイパーリンクの設定等）
' *********************************************************************************************************************
'
Sub 実行結果書式編集処理(ByRef targetSheet As Worksheet)
          
End Sub

' *********************************************************************************************************************
' 機能　：処理実行後に1度だけ実行したい処理を実装する
' *********************************************************************************************************************
'
Function 全体後処理(targetSheet As Worksheet)

End Function

' #####################################################################################################################
' #
' # テンプレートメソッド以外のメソッド
' #
' #####################################################################################################################
'

' *********************************************************************************************************************
' 機能：指定されたワークブックのモジュールをエクスポートする（ワークブック内に記載のモジュールは対象外）
' *********************************************************************************************************************
'
Public Sub ExportModules(outputPath As String, targetWB As Workbook)

    ' Dim targetModule As VBComponent
    Dim targetModule As Object

    Dim fileExt As String
    For Each targetModule In targetWB.VBProject.VBComponents
        fileExt = GetExtFromModuleType(targetModule.Type)
        If fileExt <> "" Then
            Dim filePath As String
            filePath = outputPath & "\" & targetModule.Name & "." & fileExt
            targetModule.Export filePath
            Debug.Print "Save " & targetModule.Name
        End If
    Next
    
End Sub

' *********************************************************************************************************************
' 機能：指定されたモジュールをインポートする（ワークブック内に記載のモジュールは対象外）
' *********************************************************************************************************************
'
Public Sub ImportComponents(targetWB As Workbook, フルパス_ファイル名 As String, Optional ByVal 分割ファイル情報_0 As String = "")

    ' コンポーネントの削除（事前に一括削除していた場合は、削除側は空振りとなります）
    If "" = 分割ファイル情報_0 Then
        ' コンポーネントを一括削除する
        Call DeleteComponents(targetWB)
    Else
        ' インポート対象のコンポーネントのみ削除する
        Call DeleteComponents(targetWB, 分割ファイル情報_0)
    End If
    
    ' 対象コンポーネントのインポート
    targetWB.VBProject.VBComponents.Import フルパス_ファイル名

End Sub

' *********************************************************************************************************************
' 機能：モジュールを削除する（コンポーネント名が指定されていない場合は、一括削除）
' *********************************************************************************************************************
'
Public Sub DeleteComponents(targetWB As Workbook, Optional ByVal 分割ファイル情報_0 As String = "")

    Dim targetModule As VBComponent
    For Each targetModule In targetWB.VBProject.VBComponents
        If "" <> GetExtFormModuleType(targetModule.Type) Then
            If "" = 分割ファイル情報_0 Then
                targetWB.VBProject.VBComponents.Remove targetModule
            Else
                If targetModule.Name = 分割ファイル情報_0 Then
                    targetWB.VBProject.VBComponents.Remove targetModule
                End If
            End If
        End If
    Next targetModule

End Sub

' *********************************************************************************************************************
' 機能：指定されたモジュール・タイプに対応する拡張子を返す（ワークブック内に記載のモジュールは対象外）
' *********************************************************************************************************************
'
Private Function GetExtFromModuleType(aType As Integer) As String

    Const vbext_ct_StdModule As Variant = 1
    Const vbext_ct_MSForm As Variant = 2
    Const vbext_ct_ClassModule As Variant = 3

    Select Case aType
    Case vbext_ct_StdModule
        GetExtFromModuleType = "bas"
    Case vbext_ct_ClassModule
        GetExtFromModuleType = "cls"
    Case vbext_ct_MSForm
        GetExtFromModuleType = "frm"
    End Select
    
End Function