Excel Formatar Range dinâmico na máscara do relatório - parte 2

[Martti]

Olá Senhores! Mais uma vez recorro ao conhecimento dos colegas aqui do fórum.

No tópico anterior, este aqui, o problema foi resolvido com a colaboração dos colegas.

Porém, com implementações, o relatório ficou mais detalhado.

Por padrão, a altura de linha do Excel tem limite de 409 pontos e o texto atual de alguns

relatórios tem superado este espaço, cortando o texto.

Alguns relatórios utilizam 2 à 3 páginas

Sei que o Excel não é a melhor ferramenta para esse fim, mas é o que tem para o momento.

Se algum colega tiver ideia melhor de usar máscara de relatório ou resolver esse problema

de mais de uma linha, agradeço desde já.

Replicando o tópico original:

"A empresa utiliza uma planilha que é uma máscara de formulário, onde as células são preenchidas facilmente com as funções INDICE+CORRESP.

Porém, há um campo dinâmico, o único a ser preenchido, que não consigo resolver por VBA.

Na célula A32 deve ser digitado um relatório de conformidade e vistoria. Esse relatório pode conter de 5 à "n" linhas.

Manualmente é fácil mesclar as células, quebrar o texto e justificar o alinhamento do texto. Geralmente vai até o limite impresso do relatório, coluna T.

Devido à essa variação do número de linhas do relatório e  não poder haver linhas em branco, não consigo criar uma macro para mesclar as células, quebrar o texto e justificar o alinhamento, caso contrário seria só fixar uma range(A32:T"n") e aplicar a macro."

 

cs_modelo.zip

[Martti]

Depois de muitos testes, uma apanhado de códigos que resolveram minha necessidade.

Necessário adequação para problemas específicos.

Sub FormataCélulas()

    Application.ScreenUpdating = False

    Dim cw As Double, rh As Double, cwA As Double, c As Range
    Dim lng As Long, lastrow As Long
    
    With Range("A32:AD32")
        .MergeCells = False
        cwA = .Cells(1).ColumnWidth
        For Each c In .Cells
            cw = cw + c.ColumnWidth
        Next c
        cw = cw + .Count * 0.66
        .Cells(1).ColumnWidth = cw
        .Cells(1).wrapText = True
        .EntireRow.AutoFit
        rh = .RowHeight
        .Cells(1).ColumnWidth = cwA
        .MergeCells = True
        .RowHeight = rh
        .HorizontalAlignment = xlJustify
        .VerticalAlignment = xlJustify
    End With
'-------------------------------------------------------------------------------------------------------------------------------

For lng = lastrow To 1 Step -1
        If Rows(lng).RowHeight > 408 Then
            Rows(lng + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Rows(lng).Resize(1).Select
            Selection.RowHeight = 409
            Cells(lng, "A").Resize(1, 32).Select
            With Selection
                .HorizontalAlignment = xlGeneral
                .VerticalAlignment = xlTop
                .wrapText = True
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ReadingOrder = xlContext
                .MergeCells = True
                .ShrinkToFit = True
            End With
        End If
        If lastrow > 1 Then
            ActiveCell.Offset(-1, 0).Range("A32:AD32").Select
        End If
        lastrow = lastrow - 1

    Next
    
    Application.ScreenUpdating = True

End Sub