eliW said:Hi all,
How can fill color range of cells but still preserve the original gridlines?
Eli
'// Std Module
'// Run ChangeEventOn, The format is prevented.
Option Explicit
Public ChangeEventFlg As Boolean
Sub ChangeEventOn()
ChangeEventFlg = True
End Sub
Sub ChangeEventOff()
ChangeEventFlg = False
End Sub
'// ThisWorkbook module
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
On Error GoTo ErrLine
If ChangeEventFlg = False Then Exit Sub
Dim Formerdata As Variant, ChangedData As Variant
With Application
.EnableEvents = False
.Undo
Formerdata = Target.Formula
.Undo
ChangedData = Target.Formula
.Undo
Target.Formula = ChangedData
ErrLine:
.EnableEvents = True
End With
End Sub
Dim rngPrev As Range
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not rngPrev Is Nothing Then DrawBorders rngPrev
Set rngPrev = Target
End Sub
Private Sub DrawBorders(ByVal Target As Range)
Const lngColor As Long = 15 '25% Gary
Dim lngCnt As Long
Dim rng As Range
Application.ScreenUpdating = False
For Each rng In Target
If rng.Interior.ColorIndex = xlNone Then
With rng.Borders
For lngCnt = 8 To 11
If .ColorIndex = lngColor Then
.LineStyle = xlNone
End If
Next
End With
Else
For lngCnt = 8 To 11
With rng.Borders
If .LineStyle = xlNone Then
.Weight = xlThin
.ColorIndex = lngColor
End If
End With
Next
End If
Next
Application.ScreenUpdating = True
End Sub
Option Explicit
Dim rngPrev As Range
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not rngPrev Is Nothing Then DrawBorders rngPrev
Set rngPrev = Target
End Sub
Private Sub DrawBorders(ByVal Target As Range)
Const lngColor As Long = 15 '25% Gary
Dim lngCnt As Long
Dim rng As Range
If Target.Rows.Count = Rows.Count Or Target.Columns.Count = Columns.Count Then
MsgBox "Target range is too huge, so this event would not be executed."
Exit Sub
End If
Application.ScreenUpdating = False
For Each rng In Target
If rng.Interior.ColorIndex = xlNone Then
With rng.Borders
For lngCnt = 8 To 11
If .ColorIndex = lngColor Then
.LineStyle = xlNone
End If
Next
End With
Else
For lngCnt = 8 To 11
With rng.Borders
If .LineStyle = xlNone Then
.Weight = xlThin
.ColorIndex = lngColor
End If
End With
Next
End If
Next
Application.ScreenUpdating = True
End Sub