При массовой рассылке писем КА использую функцию RangeToHtml by Ron de Bruin.
Проблема в том, что при копировании таблицы в тело письма код добавляет пустую строчку без видимых границ в конец таблицы.
При прорисовке сетки выглядит это примерно так:
При просмотре HTML кода нашел следующие строчки:
Пытался удалить через Replace, эффекта нет.
Возможно ли каким-либо образом удалить лишнюю строчку?
Стандартный код функции RangeToHtml :
Проблема в том, что при копировании таблицы в тело письма код добавляет пустую строчку без видимых границ в конец таблицы.
При прорисовке сетки выглядит это примерно так:
При просмотре HTML кода нашел следующие строчки:
| Код |
|---|
<![if supportMisalignedColumns]> <tr height=0 style='display:none'> <td width=76 style='width:57pt'></td> <td width=216 style='width:162pt'></td> <td width=113 style='width:85pt'></td> <td width=120 style='width:90pt'></td> <td width=56 style='width:42pt'></td> </tr> <![endif]> |
| Код |
|---|
RangetoHTML = Replace(RangetoHTML, "<![if supportMisalignedColumns]>*<![endif]>", _ "") |
Возможно ли каким-либо образом удалить лишнюю строчку?
Стандартный код функции RangeToHtml :
Скрытый текст |
|---|
| Function RangetoHTML(rng As Range) ' Changed by Ron de Bruin 28-Oct-2006 ' Working in Office 2000-2016 Dim fso As Object Dim ts As Object Dim TempFile As String Dim TempWB As Workbook TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm" 'Copy the range and create a new workbook to past the data in 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 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 'Read all data from the htm file into RangetoHTML Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) RangetoHTML = ts.readall ts.Close RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _ "align=left x:publishsource=") 'Close TempWB TempWB.Close savechanges:=False 'Delete the htm file we used in this function Kill TempFile Set ts = Nothing Set fso = Nothing Set TempWB = Nothing End Function |
