Excel Dividir um texto grande em várias linhas dentro de um Range definido

[Martti]

Salve colegas!

Já resolvi 90% do modelo de relatório pedido, mas tenho ainda uma questão pendente.

Os dados são registrados na Plan2(Base) através de um formulário padrão.

Na Plan3(Relatorio) existe um modelo de relatório, com células referenciadas por PROCV

até então fácil de preencher com dados numéricos.

Existe uma determinada célula referenciada na Plan2(Base) que tem que ser preenchida

com o texto do relatório de conformidade.

Como a altura máxima da célula é de 255 pixels, o texto não cabe nesta célula(B42) pois 

ultrapassa em muito esse tamanho.

A largura do formulário vai da coluna B até coluna AF, portanto, tenho limites laterais, mas sem limites de linhas.

Já quebrei a cabeça, então peço ajuda dos mais experientes.

Preciso de um código que insira o texto de B42 até AF42, quebre o texto, insira* uma linha

abaixo(B43:AF43), no mesmo limite lateral e assim sucessivamente, até a ultima linha do texto.

O texto varia muito de tamanho, na maioria das vezes mais de uma página, por isso tem que inserir linhas, tem campos abaixo e não posso ter espaço em branco, senão criaria um range definido, com células mescladas.

Pensei em criar um split com o próximo espaço vazio depois de 100 caracteres e jogar o texto para baixo, mas não consegui implementar o código.

Agradeço desde já a ajuda de todos.

*não pode pular linhas pois há mais campos abaixo, acaba sobrepondo os campos.

[Goob]

Sub QuebrarTexto()

    Dim Texto As String
    Dim TextoQuebrado() As String
    Dim i As Integer
    
    Texto = Sheets("Plan2(Base)").Range("B42:AF42").Value
    
    TextoQuebrado = Split(Texto, " ", 100)
    
    For i = 1 To UBound(TextoQuebrado)
        Sheets("Plan2(Base)").Range("B42:AF42").Offset(i, 0).EntireRow.Insert
        Sheets("Plan2(Base)").Range("B42:AF42").Offset(i, 0).Value = TextoQuebrado(i)
    Next i
    
End Sub

 

[Martti]

@Goobsegue a planilha para melhor entendimento

 

Quem puder ajudar, agradeço desde já.

 

Conformidade.zip

[Midori]

@Martti Não seria melhor fazer esse relatório no Word? Assim a planilha só seria a base com os dados a serem apresentados no documento (Correspondências > Selecionar Destinatários).

[Martti]

@Midori, obrigado pela contribuição.

Pensei nisso inicalmente, mas como a digitação de dados já é feita em formulários no excel, seria selecionar o registro no listbox e apertar um botão "Imprimir". Se não fosse esse único campo, de 20 campos, o relatório impresso já estaria em funcionamento. Aliás, sempre funcionou até então, mas foi necessário inserir este campo com a avaliação da não conformidade, que era de outro relatório.

Como já existe essa máscara de relatório pronta, com logotipo, cabeçalho etc., e há muito tempo já é utilizada com VBA, pelas boas práticas a probabilidade de erro é menor.

Foi a inserção desse campo que impactou nesse único e gigantesco problema, porque a empresa quer que continue no Excel. Manda quem pode, obedece quem tem juízo.

Já pesquisei muito, mas ainda não conseguir unir em uma macro o split, vbNewLine e Range.MergeCells.

Se alguém puder colaborar ou pensar fora da caixa, agradeço desde já.

@Midori, mais uma vez, como sempre, agradeço pela sugestão.

[Martti]

UP!

Algum dos colegas poderia melhorar este código?

Funciona 90%, mas ao atingir o limite de altura da linha (255 pixels), ele não divide

o texto adicionando uma linha abaixo.

Pode ser testado na planilha deste tópico.

Agradeço desde já.

'Code generated by OpenChat 16/04/2023
Sub FormataCélulas()
    Dim cw As Double, rh As Double, cwA As Double, c As Range
    With Range("B42:AF42")
        .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
End Sub