Mesclando várias linhas de texto formatado em uma única célula

Question

Espero que a resposta a essa pergunta me leve à questão maior, que é uma pergunta do VBA que publiquei no SO.

Se eu tiver várias linhas de texto formatado e quiser mesclar esse conteúdo em uma única célula e não perder essa formatação, isso é possível?

Parece que eu também posso:

1. Cole várias linhas de texto em uma célula (sem formatação).
2. Faça uma colagem que gerará várias células para várias linhas.

No entanto, eu quero a combinação dos dois.

Meu problema subjacente é tentar obter HTML de várias linhas em uma única célula e manter a formatação por meio do VBA. Até agora, isso não foi bem sucedido.

    

Answer 1

Esta solução tem toda a elegância de uma dança de balé de caminhão de lixo e é tão rápida quanto o mesmo caminhão preso no trânsito da hora do rush, mas funciona:

j = 1

For Each myRange In Range1
    If Range0.Value = vbNullString Then
        Range0.Value = myRange.Value
    Else
        Range0.Value = Range0.Value & Chr$(10) & myRange.Value
    End If
Next myRange

For Each myRange In Range1
    For i = 1 To myRange.Characters.Count
        Range0.Font.Name = myRange.Characters(Start:=j, Length:=1).Font.Name
        Range0.Characters(Start:=j, Length:=1).Font.FontStyle = myRange.Characters(Start:=j, Length:=1).Font.FontStyle
        Range0.Characters(Start:=j, Length:=1).Font.Size = myRange.Characters(Start:=j, Length:=1).Font.Size
        Range0.Characters(Start:=j, Length:=1).Font.Strikethrough = myRange.Characters(Start:=j, Length:=1).Font.Strikethrough
        Range0.Characters(Start:=j, Length:=1).Font.Superscript = myRange.Characters(Start:=j, Length:=1).Font.Superscript
        Range0.Characters(Start:=j, Length:=1).Font.Subscript = myRange.Characters(Start:=j, Length:=1).Font.Subscript
        Range0.Characters(Start:=j, Length:=1).Font.OutlineFont = myRange.Characters(Start:=j, Length:=1).Font.OutlineFont
        Range0.Characters(Start:=j, Length:=1).Font.Shadow = myRange.Characters(Start:=j, Length:=1).Font.Shadow
        Range0.Characters(Start:=j, Length:=1).Font.Bold = myRange.Characters(Start:=j, Length:=1).Font.Bold
        Range0.Characters(Start:=j, Length:=1).Font.Italic = myRange.Characters(Start:=j, Length:=1).Font.Italic
        Range0.Characters(Start:=j, Length:=1).Font.Underline = myRange.Characters(Start:=j, Length:=1).Font.Underline
        Range0.Characters(Start:=j, Length:=1).Font.Color = myRange.Characters(Start:=j, Length:=1).Font.Color
        Range0.Characters(Start:=j, Length:=1).Font.TintAndShade = myRange.Characters(Start:=j, Length:=1).Font.TintAndShade
        Range0.Characters(Start:=j, Length:=1).Font.ThemeFont = myRange.Characters(Start:=j, Length:=1).Font.ThemeFont
        j = j + 1
    Next i
    j = j + 1
Next myRange

Em que Range0 é o intervalo para o qual você deseja copiar as várias células e Range1 contém todas as células que você deseja copiar (nota: Range0 não pode ser um subconjunto de Range1 )