BookDecorator.txt
VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "BookDecorator" Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Explicit
Public Parent As AppDecorator Private SheetDecorators As New Collection Private SheetCount As Integer
Public ActiveSheetDecorator As SheetDecorator
Public WithEvents Target As Workbook
Private mnuAddSheet As CommandBarButton Private mnuShowSheetDecoratorCount As CommandBarButton
Public Sub Initialize(aWorkbook As Workbook, aParent As AppDecorator) Set Target = aWorkbook Set Parent = aParent SheetCount = Target.Sheets.Count OnFocus End Sub
Private Sub AddSheetDecorator(aSheet As Worksheet) Dim aSheetDecorator As New SheetDecorator aSheetDecorator.Initialize aSheet, Me SheetDecorators.Add aSheetDecorator End Sub
Private Sub RemoveInvalidSheetDecorators() Dim i As Integer For i = SheetDecorators.Count To 1 Step -1 If TypeName(SheetDecorators.Item(i).Target) <> "Worksheet" Then If SheetDecorators.Item(i) Is ActiveSheetDecorator Then Set ActiveSheetDecorator = Nothing End If SheetDecorators.Remove i End If Next i End Sub
Public Sub AddSheet() Dim aSheet As Worksheet Set aSheet = Target.Worksheets.Add AddSheetDecorator aSheet End Sub
Public Sub ShowSheetDecoratorCount() MsgBox "追加したシートの数は " & CStr(SheetDecorators.Count) & " です" End Sub
Public Sub OnFocus() Set Parent.ActiveBookDecorator = Me SetupMenus End Sub
Public Sub OnBlur() CleanupMenus Set Parent.ActiveBookDecorator = Nothing End Sub
Private Sub SetupMenus() Set mnuAddSheet = Parent.Menu.Controls.Add(Type:=msoControlButton, Temporary:=True) With mnuAddSheet .Caption = "シートの追加" .OnAction = "BookDecoratorClass.AddSheet" End With Set mnuShowSheetDecoratorCount = Parent.Menu.Controls.Add(Type:=msoControlButton, Temporary:=True) With mnuShowSheetDecoratorCount .Caption = "追加したシートの数..." .OnAction = "BookDecoratorClass.ShowSheetDecoratorCount" End With If Not ActiveSheetDecorator Is Nothing Then ActiveSheetDecorator.SetupMenus End If End Sub
Private Sub CleanupMenus() If Not ActiveSheetDecorator Is Nothing Then ActiveSheetDecorator.CleanupMenus End If If Not mnuAddSheet Is Nothing Then mnuAddSheet.Delete Set mnuAddSheet = Nothing End If If Not mnuShowSheetDecoratorCount Is Nothing Then mnuShowSheetDecoratorCount.Delete Set mnuShowSheetDecoratorCount = Nothing End If End Sub
Private Sub CheckSheetCount() If SheetCount > Target.Worksheets.Count Then RemoveInvalidSheetDecorators End If SheetCount = Target.Worksheets.Count End Sub
Private Sub Class_Terminate() OnBlur End Sub
Private Sub Target_Activate() CheckSheetCount OnFocus End Sub
Private Sub Target_BeforeClose(Cancel As Boolean) OnBlur End Sub
Private Sub Target_Deactivate() OnBlur CheckSheetCount End Sub
Private Sub Target_Open() OnFocus End Sub
Private Sub Target_SheetActivate(ByVal Sh As Object) CheckSheetCount End Sub