Public WithEvents ItemSet As Worksheet
Public WithEvents ItemSetBook As Workbook
Public WithEvents ItemSetApp As Application
Public rngOld As Range
Public OldItemSet As Worksheet
Public OldItemSetBook As Workbook
Public rngOldAddress As String
Public txtData As FormatColor
Public lngColor As Double
Public strSelect As String
Public setColor As Long
Private initCalculationValue As XlCalculation
Private Sub Class_Initialize()
Dim rngData As Range
Set ItemSet = ActiveSheet
Set ItemSetBook = ActiveWorkbook
Set OldItemSet = ActiveSheet
Set OldItemSetBook = ActiveWorkbook
Set ItemSetApp = Application
rngOldAddress = Selection.Address
Dim setColor As Long
setColor = CLng(Replace(Data.ItemData("Dev01BtnSelectChange").Image, "Color:", ""))
AppStart
For Each rngData In Selection
With rngData
ThisWorkbook.Worksheets("RangeSave").Range(rngData.Address).Interior.Pattern = rngData.Interior.Pattern
If rngData.Interior.Pattern <> xlNone Then
ThisWorkbook.Worksheets("RangeSave").Range(rngData.Address).Interior.Color = rngData.Interior.Color
End If
End With
Next rngData
AppEnd
Selection.Interior.Color = setColor
End Sub
Private Sub AppStart()
With Application
.ScreenUpdating = False
initCalculationValue = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.PrintCommunication = False
End With
End Sub
Private Sub AppEnd()
With Application
.ScreenUpdating = True
.Calculation = initCalculationValue
.EnableEvents = True
.PrintCommunication = True
End With
End Sub
Private Sub Class_Terminate()
'今のシートの範囲の変更前の色に変更
AppStart
Dim rngData As Range
For Each rngData In OldItemSetBook.Worksheets(OldItemSet.Name).Range(rngOldAddress)
With rngData
With .Interior
.Pattern = ThisWorkbook.Worksheets("RangeSave").Range(rngData.Address).Interior.Pattern
If ThisWorkbook.Worksheets("RangeSave").Range(rngData.Address).Interior.Pattern <> xlNone Then
.Color = ThisWorkbook.Worksheets("RangeSave").Range(rngData.Address).Interior.Color
End If
End With
End With
Next rngData
AppEnd
End Sub
Private Sub ItemSet_SelectionChange(ByVal Target As Range)
ChangeColor
End Sub
Private Sub ChangeColor()
Dim rngData As Range
AppStart
setColor = CLng(Replace(Data.ItemData("Dev01BtnSelectChange").Image, "Color:", ""))
'ThisWorkbook.Worksheets("RangeSave").Range(rngOldAddress).Copy OldItemSetBook.Worksheets(OldItemSet.Name).Range(rngOldAddress)
'今のシートの範囲の変更前の色に変更
For Each rngData In OldItemSetBook.Worksheets(OldItemSet.Name).Range(rngOldAddress)
With rngData
With .Interior
.Pattern = ThisWorkbook.Worksheets("RangeSave").Range(rngData.Address).Interior.Pattern
If ThisWorkbook.Worksheets("RangeSave").Range(rngData.Address).Interior.Pattern <> xlNone Then
.Color = ThisWorkbook.Worksheets("RangeSave").Range(rngData.Address).Interior.Color
End If
End With
End With
Next rngData
Set OldItemSet = ActiveSheet
Set OldItemSetBook = ActiveWorkbook
rngOldAddress = Selection.Address
'現在の選択範囲の色を保存
For Each rngData In Selection
With rngData
ThisWorkbook.Worksheets("RangeSave").Range(rngData.Address).Interior.Pattern = rngData.Interior.Pattern
If rngData.Interior.Pattern <> xlNone Then
ThisWorkbook.Worksheets("RangeSave").Range(rngData.Address).Interior.Color = rngData.Interior.Color
End If
End With
Next rngData
'Selection.Copy ThisWorkbook.Worksheets("RangeSave").Range(Selection.Address)
'色替えの実施
Selection.Interior.Color = setColor
AppEnd
End Sub
Private Sub ItemSetApp_WorkbookActivate(ByVal Wb As Workbook)
ChangeColor
Set ItemSetBook = ActiveWorkbook
Set ItemSet = ActiveSheet
End Sub
Private Sub ItemSetBook_SheetActivate(ByVal Sh As Object)
ChangeColor
Set ItemSet = ActiveSheet
End Sub