unlocking merge cells

[mauricemeijerink]

Hi all

I found a code to use on merged-cells to auto-change the row height
after updating the cell content. I changed the code a little but now I
found a problem that I can not solve, maybe someone can help me out.
The problem is: After updating the row-heigt the (unlocked) merged-
cells are getting locked, so they can't be changed when the sheet is
protected. I don't want the cells to be locked, the cells are not in a
specific range.

The code I use is:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single, OldRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range, test As Range
Dim ma As Range

With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
OldRwHt = c.RowHeight
Set ma = c.MergeArea

For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True

If NewRwHt > OldRwHt Then
ma.RowHeight = NewRwHt
Else
ma.RowHeight = OldRwHt
End If

cWdth = 0: MrgeWdth = 0: OldRwHt = 0
Application.ScreenUpdating = True

End If
End With
End Sub

Please, can someone help me out.

gr.

Maurice

 

[paul.robinson]

Hi all

I found a code to use on merged-cells to auto-change the row height
after updating the cell content. I changed the code a little but now I
found a problem that I can not solve, maybe someone can help me out.
The problem is: After updating the row-heigt the (unlocked) merged-
cells are getting locked, so they can't be changed when the sheet is
protected. I don't want the cells to be locked, the cells are not in a
specific range.

The code I use is:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single, OldRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range, test As Range
Dim ma As Range

With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
OldRwHt = c.RowHeight
Set ma = c.MergeArea

For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True

If NewRwHt > OldRwHt Then
ma.RowHeight = NewRwHt
Else
ma.RowHeight = OldRwHt
End If

cWdth = 0: MrgeWdth = 0: OldRwHt = 0
Application.ScreenUpdating = True

End If
End With
End Sub

Please, can someone help me out.

gr.

Maurice

Hi
They will only be locked if the sheet is protected and the Format,
Cells, Protection , Locked checkbox is ticked for those cells. Nothing
is in your code to do that, so the check box must be ticked for your
merged cells before the code runs?

regards
Paul

 

[mauricemeijerink]

Dear Paul,

The sheet is protected, the checkbox for locking the (merged)cells are
off. After running my code the changed merged-cells are locked, there
is my problem. You can use the code and see for yourself, make a few
merged sells en put text in them. The propertie for locking must be
set off.

regards
Maurice

 

[mauricemeijerink]

I think i found the solution, this is the code I use now:


'Deze Macro zorgt ervoor dat samengevoegde cellen in hoogte veranderen
zodra er een tekst ingevoerd wordt die groter is_
'dan de eigenlijke cel grote. De code is van toepassing op het gebruik
van een sheet die beveiligd is. Cellen die gelocked zijn_
'blijven gelocked

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single, OldRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range

'Sheet protection uit.
With ActiveSheet
.Unprotect Password:="invoer1"

'Invoer toepassen op geselecteerde cel.
With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
OldRwHt = c.RowHeight
Set ma = c.MergeArea

For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next

'Updaten van het bestand
Application.ScreenUpdating = False

'Cellen unmergen
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True

'Controle op rijhoogte
If NewRwHt > OldRwHt Then
ma.RowHeight = NewRwHt
ma.Cells.Locked = False
Else
ma.RowHeight = OldRwHt
ma.Cells.Locked = False
End If

cWdth = 0: MrgeWdth = 0: OldRwHt = 0
Application.ScreenUpdating = True

End If
End With

'Sheet protection aan.
.Protect Password:="invoer1"
End With
End Sub