Bom dia Patropi!
Usei os códigos abaixo indicados por você, todavia só funcionou o segundo (Plan2) quando dou um clique nas células mescladas.
O primeiro código (Plan3) só funciona quando dou 02 cliques nas células mescladas e depois clico fora, e ainda assim a linha fica muito larga (ver anexo).
Tem como associar o segundo código a uma botão de comando para autoajustar todas as linhas que estiverem mescladas?
Private Sub Worksheet_Change(ByVal Target As Range)
'Considerando que cada linha comporta 8 caracteres.
MaxLen = 8
'Determinar o número de caracteres expressos na célula
ActualLen = Len(Target)
'Determinar a relação entre o número de caracteres presentes e número máximo
Factor = ActualLen / MaxLen
'Ajusta a altura da linha Factor for maior que 1 unidade, em múltiplos da altura padrão
If Factor > 1 Then Rows(Target.Row).RowHeight = ActiveSheet.StandardHeight * Int(Factor)
End Sub
-------------------------------------------------------------------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range
With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
On Error Resume Next
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
cWdth = 0: MrgeWdth = 0
On Error GoTo 0
Application.ScreenUpdating = True
End If
End With
End Sub
Um abraço e obrigado mais uma vez.
Silvio.
Postado : 22/04/2013 6:46 am