Текст обрезается при публикации Excel Range в HTML - PullRequest
Новая
       19

Текст обрезается при публикации Excel Range в HTML

1 голос
/ 14 марта 2019

для автоматизации какого-либо бизнес-процесса. Я копирую диапазон ячеек Excel в почтовую программу Outlook. Я использую метод HTML, чтобы вставить диапазон в тело письма. Однако верхняя часть диапазона - это «нормальная» таблица с четкими границами. Под таблицей есть некоторый свободный текст (записанный в начале 1 ячейки).

Если свободный текст длиннее диапазона таблицы, текст обрезается и не отображается.

Есть ли обходной путь?

Найдите прикрепленный раздел кода, где генерируется HTML-файл (и текст обрезается). А также скриншот для иллюстрации. 

rng.copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
    .Cells(1).PasteSpecial Paste:=8
    .Cells(1).PasteSpecial xlPasteValues, , False, False
    .Cells(1).PasteSpecial xlPasteFormats, , False, False
    .Cells(1).Select
    Application.CutCopyMode = False
    On Error Resume Next
    .DrawingObjects.Visible = True
    .DrawingObjects.Delete
    On Error GoTo 0
End With


'Publish the sheet to a htm file
'Until here Text is displayed correctly. 
With TempWB.PublishObjects.Add( _
     SourceType:=xlSourceRange, _
     filename:=TempFile, _
     Sheet:=TempWB.Sheets(1).name, _
     Source:=TempWB.Sheets(1).UsedRange.Address, _
     HtmlType:=xlHtmlStatic)
    .Publish (True)
End With

Screenshot

Последние два слова текстового файла должны отображаться:

  • футбол вместо футб

  • домик на дереве вместо дерева

Как видите, это связано с тем, что текст выходит за границы диапазона таблицы.

Спасибо за вашу помощь. Макс

Ответы [ 2 ]

1 голос
/ 14 марта 2019

Чтобы убедиться, что текст не выходит за пределы или скрыт внутри данных / ячейки HTML-таблицы, вы можете использовать .AutoFit , чтобы ширина столбцов соответствовала длине текста в ячейках, перед сохранением в виде HTML-файл.

Это гарантирует, что ширина HTML-таблицы вмещает весь текст.

Просто добавьте следующую строку: .Cells.EntireColumn.AutoFit

Вот обновленный раздел кода: 

With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
.Cells.EntireColumn.AutoFit ' Added line of code to make column widths match the text length
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
1 голос
/ 14 марта 2019

Вот функция, которая обрезает строку текста, чтобы уместиться в пределах указанной ширины: 

Function TrimTextToWidth(Text As String, Width As Double) As String
    'We need to put the Text into a Shape to measure the width
    'You may need to change the Font Formatting of the Shape to match your cell
    With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 10 * (Len(Text) + 1), (30 * (1 + Len(Text) - Len(Replace(Text, vbLf, "")))))
        .TextFrame2.TextRange.Text = Text
        'Trim the text until it fits within the width
        While (.TextFrame2.TextRange.Characters.BoundWidth > Width) And Len(.TextFrame2.TextRange.Text) > 0
            .TextFrame2.TextRange.Text = Left(.TextFrame2.TextRange.Text, Len(.TextFrame2.TextRange.Text) - 1)
        Wend
        TrimTextToWidth = .TextFrame2.TextRange.Text
        'Remove the shape when we have finished with it
        .Delete
    End With
End Function
...