擬似継承＆コールバック関数（イベント）で定番の処理を共通化

#擬似継承＆コールバック関数（イベント）で定番の処理を共通化

RelaxTools Addin というソフトを公開しております。
Excelのアドインソフトですが、以下のような機能のマクロが100以上存在します。

1. （処理したい）セルを選択する
2. 選択したセルに対して処理を行う

ただこれだけなのですがソフトとして公開となるといろいろ共通的に必要になるものがあります。

1. そもそもActiveCellがあるか？
2. 選択されているのはシェイプか？セルか？
3. 選択エリアが複数ないか？
4. 非常に大量のセルが選択されていないか？
5. セルが連結されていないか？
6. 行や列が非表示やフィルタされていないか？
7. 選択されたセルの中で文字列のあるセルのみを抽出する。
8. 画面表示がチラチラしないようにApplication.ScreenUpdatingで制御する。

　などなど盛りだくさんあり、これらを100以上も実装してたらたいへんなことになります。

そこで選択セルの処理を行うフレームワークを作成、必要な処理のみを記述すればよいようにしました。
この例では、選択されたセルの値を小文字に変換する機能となります。


##basExecute.bas
機能の呼び出し部分です。New して唯一のメソッド Run を実行しています。

```vb.net:basExecute.bas
Option Explicit
'--------------------------------------------------------------
' 小文字変換(SelectionFrameWork使用)
'--------------------------------------------------------------
Sub execSelectionToLower()

    Dim obj As SelectionToLower
    Set obj = New SelectionToLower
    
    obj.Run
    
    Set obj = Nothing

End Sub
```
##SelectionToLower.cls

文字列を小文字化する実装部分です。
前半のお約束記述部分が擬似継承です。親クラスのRunメソッドを実行します。
その後、「前処理」「主処理」「後処理」の順に実行されます。
「主処理」は選択されているセルの数だけ実行されます。
内容的には StrConv コマンドで小文字しているだけです。
エラーなどで処理を中断したい場合には、引数のCancelにTrueをセットします。

```VB.NET:SelectionToLower.cls
Option Explicit
'--- ここから SelectionFrameWork を使用する場合のお約束記述 ---
Private WithEvents SFWork As SelectionFrameWork
Private Sub Class_Initialize()
    Set SFWork = New SelectionFrameWork
End Sub
Private Sub Class_Terminate()
    Set SFWork = Nothing
End Sub
Public Sub Run()
    SFWork.Run
End Sub
'--- ここまで SelectionFrameWork を使用する場合のお約束記述 ---

'----------------------------------------------------------------------------------------------------
' 前処理(UOC)
'----------------------------------------------------------------------------------------------------
Private Sub SFWork_SelectionInit(Cancel As Boolean)
    '処理があれば書く。キャンセルしたい場合には Cancel = true とする
End Sub

'----------------------------------------------------------------------------------------------------
' 主処理(UOC)
'----------------------------------------------------------------------------------------------------
Private Sub SFWork_SelectionMain(r As Range, Cancel As Boolean)
        
    On Error GoTo e
    
    'セルの値を小文字にする
    r.Value = StrConv(r.Value, vbLowerCase)

    Exit Sub
e:
    Cancel = True
End Sub
'----------------------------------------------------------------------------------------------------
' 後処理(UOC)
'----------------------------------------------------------------------------------------------------
Private Sub SFWork_SelectionTerm()
    '処理があれば書く
End Sub
```

##SelectionFrameWork.cls

定番の処理を共通化したフレームワーク「SelectionFramework」です。
処理の流れや雑多なチェック処理が記述されており、RaiseEventにより、呼び元のコールバック関数を実行します。
この例ではシンプルにするためにUndoの処理や処理中メッセージなどが省かれています。:-)

```VB.NET:SelectionFrameWork.cls
'--------------------------------------------------------------
' Selectionに含まれるCellの数だけ処理を行うフレームワーク
'--------------------------------------------------------------
Option Explicit

'メッセージタイトル
Private Const C_TITLE As String = "SelectionFrameWork"
'セルの選択セル警告数
Private Const C_MAX_CELLS As Long = 100000
'初期化イベント
Public Event SelectionInit(ByRef Cancel As Boolean)
'メインイベント
Public Event SelectionMain(ByRef r As Range, ByRef Cancel As Boolean)
'終了イベント
Public Event SelectionTerm()

'処理実行部
Public Sub Run()

    '変数宣言
    Dim r As Range
    Dim Cancel As Boolean
    Dim sel As Range
    Dim colMerge As Collection
    
    On Error GoTo ErrHandle
    
    'キャンセルの初期化
    Cancel = False
    
    Dim blnRange As Boolean
    blnRange = False
    Select Case True
        Case ActiveWorkbook Is Nothing
        Case ActiveCell Is Nothing
        Case Selection Is Nothing
        Case TypeOf Selection Is Range
            blnRange = True
        Case Else
    End Select
    If blnRange Then
    Else
        MsgBox "選択範囲が見つかりません。", vbCritical, C_TITLE
        Exit Sub
    End If
    
    '使われているセルと現在選択セルのAND部分のみ処理する。
    Set sel = Intersect(ActiveSheet.UsedRange, Selection)
    
    '重複する選択が無い場合終了。
    If sel Is Nothing Then
        Exit Sub
    End If
    
    Dim ret As VbMsgBoxResult
    If sel.CountLarge > C_MAX_CELLS Then
        ret = MsgBox("大量のセルが選択されています。処理に時間がかかりますが続行しますか？", vbInformation + vbOKCancel + vbDefaultButton2, C_TITLE)
        If ret = vbCancel Then
            Exit Sub
        End If
    End If

    '---------------------------
    '初期化イベント
    '---------------------------
    RaiseEvent SelectionInit(Cancel)
    
    'キャンセルの場合
    If Cancel Then
        Exit Sub
    End If
    
    Set colMerge = New Collection
    Dim strAddress As String
    
    Application.ScreenUpdating = False
    
    For Each r In sel
    
        ''フィルタおよび非表示対策。
        If r.Rows.Hidden Or r.Columns.Hidden Then
            'フィルタまたは非表示の行・列の処理は行わない。
        Else
            
            'マージセル対策
            strAddress = r.MergeArea(1, 1).Address
            Dim e As Range
            
            On Error Resume Next
            Set e = Nothing
            Set e = colMerge(strAddress)
            
            On Error GoTo 0
            
            'アドレスが登録されていない場合イベントを起こす
            If err.Number = 0 And Not (e Is Nothing) Then
            Else
                '---------------------------
                'メインイベント
                '---------------------------
                If IsEmpty(r.Value) Or IsError(r.Value) Then
                Else
                    RaiseEvent SelectionMain(r, Cancel)
                    If Cancel Then
                        Exit For
                    End If
                End If
                
                colMerge.Add r, strAddress
            End If
            
        End If
        
    Next
    
    Application.ScreenUpdating = True
    
    '---------------------------
    '終了イベント
    '---------------------------
    Application.ScreenUpdating = False
    
    RaiseEvent SelectionTerm
    
    Application.ScreenUpdating = True
    
    Exit Sub
ErrHandle:
    MsgBox "エラーが発生しました。", vbOKOnly, C_TITLE
End Sub
```

大分複雑な記述ですが、一度フレームワークを作ってしまえば、必要な部分の実装だけでかなりリッチなプログラムが作成可能です。

他のソースをごらんになりたい方はこちらへ
Excelを便利にする250以上の機能を体系化したアドインはこちらです。
「RelaxTools Addin」窓の杜大賞受賞ソフト
http://software.opensquare.net/relaxtools/