Set1-ZZZ

Excel VBA Base Book
2023.05.01

Base Procedure Set 1
　VBAのテンプレートブック
　こちらは、基本となるメインのプロシージャ、Call されるサブプロシージャ、Call され Callするサブプロシージャ例です。
　作成時、修正時の開発効率とデバッグのしやすさを重視した構成にしています。

  1. まず、下記ボックス内をコピーし、標準モジュールに貼り付ける。
  2. 次に、モジュール名を【ZZZ_BasePros 】に変更する。
  3. 利用時は、使用する標準モジュールにプロシージャをコピーし、☆☆☆、★★★、●●● 等の記号を、【Ctrl】+【H】で、プロシージャー名に置き換えて、使用する。
　Module : ZZZ_BasePros 　　‘開発時使用モジュール
Option Explicit

'**********************************************************
' Main Sub：処理の起点。
'**********************************************************
Sub ☆☆☆()

    'ループ変数
    Dim i As Long
    Dim MaxRow As Long

    '処理記録用（メッセージ・記録セル・時間・終了フラグ）
    Dim myMsg As String, strRng As String
    Dim sttTime As Date, endTime As Date, exeTime As Date
    Dim nmlTmn As Boolean    '正常終了フラグ：normal Termination

    myProcd = "☆☆☆"
    strRng = "I8"
    IsCall = False
    nmlTmn = False

    On Error GoTo ☆☆☆_Err

    Call showStatus("～ 処理中...")

    sttTime = Now()
    Call InputStt(strRng)

    Call StopUpdating
    Call SetObject

    '-----------------------------------------------------------
    'ここにメイン処理を記入
'    With ActiveSheet
'        MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row
'        For i = 2 To MaxRow
'
'        Next i
'    End With
    '-----------------------------------------------------------

'    IsCall = True
'    Call ★★★
'    IsCall = False

    nmlTmn = True

☆☆☆_Exit:

    '一時的にエラー無視
    On Error Resume Next
    Call ReSetObject
    Call Updating

    endTime = Now()
    exeTime = endTime - sttTime

    If nmlTmn Then
        Call InputEnd(strRng, exeTime)
        MsgBox " 完了♪"
    Else
        'Call InputErr(strRng, exeTime)
        'MsgBox "異常終了しました。", vbExclamation, myProcd
    End If
    'エラーハンドリング解除
    On Error GoTo 0
    Exit Sub

☆☆☆_Err:

    nmlTmn = False
    endTime = Now()
    exeTime = endTime - sttTime
    Debug.Print exeTime
    
    '【ESC】で止められた場合（※止まらない環境もあります）
    If Err.Number = 18 Then
        If MsgBox("マクロを終了しますか？", vbYesNo) = vbNo Then
            Resume
        Else
            Call exeBreak
            Err.Clear
            GoTo ☆☆☆_Exit
        End If
    Else
        Call InputErr(strRng, exeTime)
        MsgBox "実行時エラー:" & Err.Number & "" & _
            Err.Description & vbCr & _
            "処理を終了します。", vbExclamation, myProcd
        Call exeBreak
        Err.Clear
        GoTo ☆☆☆_Exit
    End If

End Sub

'**********************************************************
' Call Sub：他プロシージャから呼ばれる処理
'**********************************************************
Sub ★★★()

    'ループ変数
    Dim i As Long
    Dim MaxRow As Long

    '処理記録用（メッセージ・記録セル・時間・終了フラグ）
    Dim myMsg As String, strRng As String
    Dim sttTime As Date, endTime As Date, exeTime As Date
    Dim nmlTmn As Boolean    '正常終了フラグ

    myProcd = "★★★"
    nmlTmn = False

    On Error GoTo ★★★_Err

    Call showStatus("～ 処理中...")

    '単独実行時のみ初期処理
    If IsCall = False Then
        sttTime = Now()
        Call StopUpdating
        Call SetObject
    End If

    '-----------------------------------------------------------
    'ここにメイン処理を記入
'    With ActiveSheet
'        MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row
'        For i = 2 To MaxRow
'
'        Next i
'    End With
    '-----------------------------------------------------------

    '単独実行時のみ正常終了フラグ ON
    If IsCall = False Then
        nmlTmn = True
    End If

★★★_Exit:

    If IsCall = False Then
    
        '一時的にエラー無視
        On Error Resume Next
        Call ReSetObject
        Call Updating

        endTime = Now()
        exeTime = endTime - sttTime

        If nmlTmn Then
            Call InputEnd(strRng, exeTime)
            MsgBox " 完了♪"
        Else
            'Call InputErr(strRng, exeTime)
            'MsgBox "異常終了しました。", vbExclamation, myProcd
        End If
        'エラーハンドリング解除
        On Error GoTo 0
    End If

    Exit Sub

★★★_Err:

    nmlTmn = False
    endTime = Now()
    exeTime = endTime - sttTime
    Debug.Print exeTime

    '【ESC】で止められた場合（※止まらない環境もあります）
    If Err.Number = 18 Then
        If MsgBox("マクロを終了しますか？", vbYesNo) = vbNo Then
            Resume
        Else
            Call exeBreak
            Err.Clear
            GoTo ★★★_Exit
        End If
    Else
        MsgBox "実行時エラー:" & Err.Number & "" & _
            Err.Description & vbCr & _
            "処理を終了します。", vbExclamation, myProcd
        Call exeBreak
        Err.Clear
        GoTo ★★★_Exit
    End If

End Sub

'**********************************************************
' 中間処理 Sub：他プロシージャから呼ばれ、さらに処理を呼び出す
'**********************************************************
Sub ●●●()

    'ループ変数
    Dim i As Long
    Dim MaxRow As Long

    '処理記録用（メッセージ・記録セル・時間・終了フラグ）
    Dim myMsg As String, strRng As String
    Dim sttTime As Date, endTime As Date, exeTime As Date
    Dim nmlTmn As Boolean    '正常終了フラグ

    myProcd = "●●●"
    nmlTmn = False

    On Error GoTo ●●●_Err

    Call showStatus("～ 処理中...")

    '単独実行時のみ初期処理
    If IsCall = False Then
        sttTime = Now()
        Call StopUpdating
        Call SetObject
    End If

    '-----------------------------------------------------------
    '【BlnCall】この処理が単独実行かどうかを判定するフラグ
    '           True：親プロシージャから呼ばれた
    '           False：単独実行（画面更新やオブジェクト制御を行う）
    '※ IsCallとは階層が異なるため、統一しないこと！
    '-----------------------------------------------------------
    BlnCall = True

    '-----------------------------------------------------------
    'ここにメイン処理を記入
'    With ActiveSheet
'        MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row
'        For i = 2 To MaxRow
'
'        Next i
'    End With

    BlnCall = True
    Call ●★●
    BlnCall = False
    '-----------------------------------------------------------

    If IsCall = False Then
        nmlTmn = True
    End If

●●●_Exit:

    If IsCall = False Then
    
        '一時的にエラー無視
        On Error Resume Next
        Call ReSetObject
        Call Updating

        endTime = Now()
        exeTime = endTime - sttTime

        If nmlTmn Then
            Call InputEnd(strRng, exeTime)
            MsgBox " 完了♪"
        Else
            'Call InputErr(strRng, exeTime)
            'MsgBox "異常終了しました。", vbExclamation, myProcd
        End If
        'エラーハンドリング解除
        On Error GoTo 0
    End If

    Exit Sub

●●●_Err:

    nmlTmn = False
    endTime = Now()
    exeTime = endTime - sttTime
    Debug.Print exeTime

    '【ESC】で止められた場合（※止まらない環境もあります）
    If Err.Number = 18 Then
        If MsgBox("マクロを終了しますか？", vbYesNo) = vbNo Then
            Resume
        Else
            Call exeBreak
            Err.Clear
            GoTo ●●●_Exit
        End If
    Else
        MsgBox "実行時エラー:" & Err.Number & "" & _
            Err.Description & vbCr & _
            "処理を終了します。", vbExclamation, myProcd
        Call exeBreak
        Err.Clear
        GoTo ●●●_Exit
    End If

End Sub
'**********************************************************
' Call Sub：●●●から呼ばれる処理
'**********************************************************
Sub ●★●()

    'ループ変数
    Dim i As Long
    Dim MaxRow As Long

    '処理記録用（メッセージ・記録セル・時間・終了フラグ）
    Dim myMsg As String, strRng As String
    Dim sttTime As Date, endTime As Date, exeTime As Date
    Dim nmlTmn As Boolean    '正常終了フラグ

    myProcd = "●★●"
    nmlTmn = False

    On Error GoTo ●★●_Err

    Call showStatus("～ 処理中...")

    '単独実行時のみ初期処理
    If BlnCall = False Then
        sttTime = Now()
        Call StopUpdating
        Call SetObject
    End If

    '-----------------------------------------------------------
    'ここにメイン処理を記入
'    With ActiveSheet
'        MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row
'        For i = 2 To MaxRow
'
'        Next i
'    End With
    '-----------------------------------------------------------

    If BlnCall = False Then
        nmlTmn = True
    End If

●★●_Exit:

    If BlnCall = False Then
    
        '一時的にエラー無視
        On Error Resume Next
        Call ReSetObject
        Call Updating

        endTime = Now()
        exeTime = endTime - sttTime

        If nmlTmn Then
            Call InputEnd(strRng, exeTime)
            MsgBox " 完了♪"
        Else
            'Call InputErr(strRng, exeTime)
            'MsgBox "異常終了しました。", vbExclamation, myProcd
        End If
        'エラーハンドリング解除
        On Error GoTo 0
    End If

    Exit Sub

●★●_Err:

    nmlTmn = False
    endTime = Now()
    exeTime = endTime - sttTime
    Debug.Print exeTime

    '【ESC】で止められた場合（※止まらない環境もあります）
    If Err.Number = 18 Then
        If MsgBox("マクロを終了しますか？", vbYesNo) = vbNo Then
            Resume
        Else
            Call exeBreak
            Err.Clear
            GoTo ●★●_Exit
        End If
    Else
        MsgBox "実行時エラー:" & Err.Number & "" & _
            Err.Description & vbCr & _
            "処理を終了します。", vbExclamation, myProcd
        Call exeBreak
        Err.Clear
        GoTo ●★●_Exit
    End If

End Sub

コメント

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