InterfaceによるなんちゃってUsing句を作る

以下のようなロジックを組んでいていろいろな終了処理めんどくせぇ~
一発でなんとかなんねーかということで、Interface でなんとかしてみた。
かなりめんどくささを強調しているのであまりつっこまないように。

下記の例だと、
・Application.ScreenUpdating の設定
・別Excel 起動時の終了処理
・処理中フォームの開始・終了処理
の処理が面倒な感じです。C# なら Using句とかで自動で終了できて便利ですね。

ありがちな例

Sub MainMae()

    Dim lngCount As Long
    Dim lngMax As Long
    Dim blnCancel As Boolean
    
    If MsgBox("実行しますか?", vbQuestion + vbOKCancel) <> vbOK Then
        Exit Sub
    End If
    
    On Error GoTo e
    
    lngCount = 0
    lngMax = 100000
    
    frmWait.TitleBar = "サンプル"
    frmWait.Message = "テスト中..."
    
    Dim XL As Excel.Application
    Set XL = New Excel.Application
    
    frmWait.Show
    
    Application.ScreenUpdating = False
    Application.Cursor = xlWait
    
    frmWait.StartGauge lngMax
    
    '別プロセスでのExcel起動
    XL.Visible = True
    
    Do Until lngCount > lngMax
    
        If frmWait.IsCancel Then
            blnCancel = True
            Exit Do
        End If
        
        lngCount = lngCount + 1
        frmWait.DisplayGauge lngCount
    Loop

    Unload frmWait
    Application.ScreenUpdating = True
    Application.Cursor = xlDefault

    XL.Quit
    Set XL = Nothing

    If blnCancel Then
        MsgBox "キャンセルされました。", vbExclamation
    Else
        MsgBox "完了", vbInformation
    End If
    Exit Sub
e:
    Unload frmWait
    Application.ScreenUpdating = True
    Application.Cursor = xlDefault
    
    XL.Quit
    Set XL = Nothing
    
    MsgBox "エラーです。", vbCritical

End Sub

ソース

以下、いくつかクラスを作成します。
インターフェイス IConstructorを定義する。

Option Explicit
'---------------------------------------------------
' コンストラクタ呼び出し
'---------------------------------------------------
Public Function Instancing(ByRef Args As Collection) As Object
End Function

インターフェイス IUsing を定義する。

Option Explicit
Public Sub Begin()
End Sub
Public Sub Finish()
End Sub

Excel の高速化クラスを作成、インターフェイス IUsing をImplimentsし、Begin/Finishメソッドに内容を記述する。
参考)VBA マクロの高速化のためのApplication設定をクラスモジュールにまとめる

Option Explicit
Implements IUsing

Private mScreenUpdating As Boolean
Private mCalculation As XlCalculation
Private mEnableEvents As Boolean
Private mPrintCommunication As Boolean
Private mDisplayAlerts As Boolean

Private Sub IUsing_Begin()
    
    'Applicationのプロパティを保存する。
    With Application
        mScreenUpdating = .ScreenUpdating
        mCalculation = .Calculation
        mEnableEvents = .EnableEvents
        mPrintCommunication = .PrintCommunication
        mDisplayAlerts = .DisplayAlerts
    End With

    'Applicationのプロパティを変更する。
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .PrintCommunication = False
        .DisplayAlerts = False
        
        .Cursor = xlWait
    End With

End Sub

Private Sub IUsing_Finish()
    
    'Applicationのプロパティを復元する。
    With Application
        .ScreenUpdating = mScreenUpdating
        .Calculation = mCalculation
        .EnableEvents = mEnableEvents
        .PrintCommunication = mPrintCommunication
        .DisplayAlerts = mDisplayAlerts
        
        .Cursor = xlDefault
        .StatusBar = False
    
    End With

End Sub

Excel の起動クラスを作成、インターフェイス IUsing を同様に適用する。

Option Explicit
Implements IUsing

Private mXL As Excel.Application
'Instance を取得時にオブジェクトを生成する。
Public Property Get GetInstance() As Excel.Application
    If mXL Is Nothing Then
        Set mXL = New Excel.Application
        mXL.EnableEvents = False
        mXL.PrintCommunication = False
        mXL.DisplayAlerts = False
    End If
    Set GetInstance = mXL
End Property

Private Sub Class_Terminate()
    Call IUsing_Finish
End Sub

Private Sub IUsing_Begin()

End Sub

Private Sub IUsing_Finish()
    
    If Not mXL Is Nothing Then
        mXL.Quit
    End If
    Set mXL = Nothing

End Sub

処理中フォームで インターフェイス IUsing を同様に適用する。
フォームもクラスなのでインターフェースが使えます。余談ですが UserForm型って挙動がインターフェースっぽいな。

Option Explicit
Implements IUsing

'処理をざっくり省略

'--------------------------------------------------------------
' IUsing I/F Begin
'--------------------------------------------------------------
Private Sub IUsing_Begin()
    m_Cancel = False
    Me.Show
End Sub
'--------------------------------------------------------------
' IUsing I/F Finish
'--------------------------------------------------------------
Private Sub IUsing_Finish()
    Unload Me
End Sub

コンストラクタのヘルパー関数

Option Explicit
'自クラスまたはCollectionのコンストラクタを定義
Public Function Constructor(ByRef obj As Object, ParamArray Args() As Variant) As Object

    Dim c As IConstructor
    Dim v As Variant
    
    '引数をCollectionに詰め替える
    Dim col As Collection
    Set col = New Collection
    For Each v In Args
        col.Add v
    Next
        
    'IConstructor Interfaceを呼び出す。
    Set c = obj
    Set Constructor = c.Instancing(col)
    
    'オブジェクトが返却されなかった場合エラー
    If Constructor Is Nothing Then
        Err.Raise vbObjectError + 512 + 1, "Argument Error"
    End If

End Function

Using クラスを作成、コンストラクタで各オブジェクトをコレクションに登録、各オブジェクトのBegin メソッドを呼び出す。
また、 Class_Terminate にて各オブジェクトのFinishメソッドを呼び出す。
これにより、IUsingインターフェースのあるクラスであれば、指定されたメソッドの開始処理、終了処理を一括して行うことが可能となります。

Option Explicit
Implements IConstructor

Private m_col As Collection
'--------------------------------
' With 時点で実行
'--------------------------------
Private Function IConstructor_Instancing(Args As Collection) As Object

    Dim v As IUsing

    If Args.Count = 0 Then
        Exit Function
    End If

    Set m_col = Args

    For Each v In m_col
        v.Begin
    Next
    
    Set IConstructor_Instancing = Me

End Function
'--------------------------------
'End With 時点で実行
'--------------------------------
Private Sub Class_Terminate()

    Dim v As IUsing
    Dim i As Long
    
    'IUsingI/F同士に関連があるとアレなので、逆順に実行
    For i = m_col.Count To 1 Step -1
        Set v = m_col(i)
        v.Finish
    Next
    
    Set m_col = Nothing

End Sub
'--------------------------------
' Args
'--------------------------------
Public Property Get Args() As Collection
    Set Args = m_col
End Property

改善後

改善後の記述は以下のようになります。すっきりしましたね。
End With で UsingクラスのClass_Terminateが実行され、各クラスのFinishメソッドが実行されます。
エラーの時にはUsingオブジェクトがスコープ外になった時に各クラスのFinishメソッドが実行され、処理のこりが防止できます。

Sub Main()

    Dim lngCount As Long
    Dim lngMax As Long
    Dim blnCancel As Boolean
    
    If MsgBox("実行しますか?", vbQuestion + vbOKCancel) <> vbOK Then
        Exit Sub
    End If
    
    On Error GoTo e
    
    lngCount = 0
    lngMax = 100000
    
    frmWait.TitleBar = "サンプル"
    frmWait.Message = "テスト中..."
    
    Dim XL As NewExcel
    
    Set XL = New NewExcel
    
    'なんちゃってUsingに IUsing I/F に対応したクラスを指定する。
    With Constructor(New Using, XL, New OneTimeSpeedBooster, frmWait)
    
        frmWait.StartGauge lngMax
        
        '別プロセスでのExcel起動
        XL.GetInstance.Visible = True
        
        Do Until lngCount > lngMax
        
            If frmWait.IsCancel Then
                blnCancel = True
                Exit Do
            End If
            
            lngCount = lngCount + 1
            frmWait.DisplayGauge lngCount
        Loop

    End With
    'IUsing I/Fに対応したクラスはここで終了する。

    If blnCancel Then
        MsgBox "キャンセルされました。", vbExclamation
    Else
        MsgBox "完了", vbInformation
    End If
    Exit Sub
e:
    MsgBox "エラーです。", vbCritical
End Sub

サンプルダウンロード(Using.xlsm)

ABOUTこの記事をかいた人

はてなブックマークで驚愕の1600越えを記録した伝説が今明らかに! エクセル方眼紙 四天王の1人(ほぼ最弱)窓の杜大賞2014 大賞受賞! Excelを便利にする250以上の機能を体系化したアドインはこちらです。