Skip to content.

Sections
Personal tools
You are here: Home » コミュニティ » masarl memorial » homepage3.nifty.com » masarl » article » excel-decorator » BookDecorator.txt

BookDecorator.txt

Document Actions

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