'Copy to Workbook Code---------------------------------------------------------------
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.CalculateFull
End Sub
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
Application.CalculateFull
End Sub
'Nếu bỏ Code trên thì phải Click Double vào ô thì màu mới đổi
'Nếu Excel của bạn nhiều cell chứa công thức thì bỏ Code trên
'---------------------------------------------------------------
'Copy to Module---------------------------------------------------------------
'Code này không bỏ
Function ChangeBgrCell(Rng As Range, Optional ByVal IsDigit As Boolean = False)
If IsArray(Rng) Then Exit Function
ChangeBgrCell = IIf(IsDigit, 0, "")
With Application.Caller
.Parent.Evaluate _
"callChangeBgrCell(" & .Parent.Name & "!" & .Address(False, False) & "," & _
Rng.Parent.Name & "!" & Rng.Address(False, False) & ")"
End With
End Function
Private Sub callChangeBgrCell(Cell As Range, frCell As Range)
On Error Resume Next
With Cell.Interior
.Pattern = frCell.Interior.Pattern
.PatternColorIndex = frCell.Interior.PatternColorIndex
.Color = frCell.Interior.Color
.TintAndShade = frCell.Interior.TintAndShade
.PatternTintAndShade = frCell.Interior.PatternTintAndShade
End With
With Cell.Font
.ThemeColor = frCell.Font.ThemeColor
.TintAndShade = frCell.Font.TintAndShade
End With
End Sub