M
Marie J-son
Hi,
I have a O.K. routine today that restore format when merged cells are the
target in a worksheet_change event. The code is like below - for testing
merge cells A11 and forward to row 10.
Now I need to restore format by button and need to change the routine to
work with all merged cells from A11 to A1010. How can I do that - I've
tried a while now but can't get the procedure right. Please help. Manybe
your solution can handle the last two inhibited row to unlock cells and
unhide them ...:? The button connection is not a probelm -the probelm is to
reference the merged cells, make the object right, to take them one by one
in a loop or...?
(To test routine: Merge cells A11 and forward to row 10)
Private Sub Worksheet_Change(ByVal Target As Range)
'****** Restore merged cells format by change ************
If Not Application.Intersect(Target, Sheet1.Range("A110")) Is Nothing Then
Target.NumberFormat = "@"
With Target
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Target.Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
' ----------Need borders around mergedcells, not within their cells
Dim sel As Range
Set sel = Sheet1.Range(Cells(Target.Row, Target.Column),
Cells(Target.Row, Target.Column + 3))
sel.Borders(xlDiagonalDown).LineStyle = xlNone
sel.Borders(xlDiagonalUp).LineStyle = xlNone
With sel.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With sel.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 37
End With
With sel.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 37
End With
With sel.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
sel.Borders(xlInsideVertical).LineStyle = xlNone
With Target.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = 10
End With
sel.FormatConditions.Delete
'sel.Locked = False
'sel.FormulaHidden = False
End If
End Sub
I have a O.K. routine today that restore format when merged cells are the
target in a worksheet_change event. The code is like below - for testing
merge cells A11 and forward to row 10.
Now I need to restore format by button and need to change the routine to
work with all merged cells from A11 to A1010. How can I do that - I've
tried a while now but can't get the procedure right. Please help. Manybe
your solution can handle the last two inhibited row to unlock cells and
unhide them ...:? The button connection is not a probelm -the probelm is to
reference the merged cells, make the object right, to take them one by one
in a loop or...?
(To test routine: Merge cells A11 and forward to row 10)
Private Sub Worksheet_Change(ByVal Target As Range)
'****** Restore merged cells format by change ************
If Not Application.Intersect(Target, Sheet1.Range("A110")) Is Nothing Then
Target.NumberFormat = "@"
With Target
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Target.Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
' ----------Need borders around mergedcells, not within their cells
Dim sel As Range
Set sel = Sheet1.Range(Cells(Target.Row, Target.Column),
Cells(Target.Row, Target.Column + 3))
sel.Borders(xlDiagonalDown).LineStyle = xlNone
sel.Borders(xlDiagonalUp).LineStyle = xlNone
With sel.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With sel.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 37
End With
With sel.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 37
End With
With sel.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
sel.Borders(xlInsideVertical).LineStyle = xlNone
With Target.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = 10
End With
sel.FormatConditions.Delete
'sel.Locked = False
'sel.FormulaHidden = False
End If
End Sub