unlocking merge cells
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
|