3.5 プログラムのまとめ

最後に、作成したプログラムをまとめておきましょう。

1. 目的

あるブックfoo.xlsを扱う以下の機能を別のブックに実装する。

2. [Class] SheetDecorator


Public WithEvents wsheet As Worksheet
Private parent As BookDecorator

Sub Initialize(ws As Worksheet, bd As BookDecorator)
    Set wsheet = ws
    Set parent = bd
End Sub

Private Sub wsheet_Activate()
    MsgBox parent.wbook.Name & ":" & wsheet.Name
End Sub

3. [Class] BookDecorator

Public WithEvents wbook As Workbook
Private SheetDecorators As New Collection 'of SheetDecorator

Public Sub Initialize(wb As Workbook)
    Set wbook = wb
    SetSheetDecorator Worksheets(1)
    SetSheetDecorator Worksheets(2)
End Sub

Private Sub SetSheetDecorator(ws As Worksheet)
    Dim sd As New SheetDecorator
    sd.Initialize ws, Me
    SheetDecorators.Add Item:=sd
End Sub

Private Sub wbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim f As Boolean
    f = MsgBox("ブックを本当に保存してよろしいでしょうか。", vbYesNo)
    If f = vbNo Then Cancel = True
End Sub

4. [Class] AppDecorator

Private WithEvents app As Application
Private bookDeco As BookDecorator

Public Sub Initialize()
    Set app = Application
    Dim wb As Workbook
    For Each wb In Workbooks
        If wb.Name = "foo.xls" Then
            Set bookDeco = New BookDecorator
            bookDeco.Initialize wb
        End If
    Next
End Sub

Private Sub Class_Terminate()
    Set bookDeco = Nothing
End Sub

Private Sub app_WorkbookOpen(ByVal wb As Workbook)
    If wb.Name = "foo.xls" Then
        Set bookDeco = New BookDecorator
        bookDeco.Initialize wb
    End If
End Sub

Private Sub app_WorkbookBeforeClose(ByVal wb As Workbook, Cancel As Boolean)
    If wb.Name = ("foo.xls") Then
        Set bookDeco = Nothing
    End If
End Sub

5. [Module] AppDecoModule

Dim appDeco As New AppDecorator

Sub Test()
    appDeco.Initialize
End Sub