Вставка таблицы Excel в электронном письме Outlook: он оглядывается назад

Мне удалось запустить следующий код для копирования диапазона Excel в электронную почту Outlook (используя код, предоставленный Рон де Бруин:

Sub SendEMail(SheetName As String, EmailBody As String, EmailSubject As String, MyAttachment As String) ' You need to use this module with the RangetoHTML subroutine. ' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010. Dim rng As Range Dim OutApp As Object Dim OutMail As Object Set rng = Nothing On Error Resume Next ' Only send the visible cells in the selection. ActiveSheet.Unprotect Set rng = ActiveSheet.Range(EmailBody).SpecialCells(xlCellTypeVisible) ' You can also use a range with the following statement. ' Set rng = Sheets("YourSheet").Range("D4:D12").SpecialCells(xlCellTypeVisible) On Error GoTo 0 If rng Is Nothing Then MsgBox "The selection is not a range or the sheet is protected. " & _ vbNewLine & "Please correct and try again.", vbOKOnly Exit Sub End If With Application .EnableEvents = False .ScreenUpdating = False End With Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail '.To = "[email protected]" '.CC = "" '.BCC = "" .subject = "Resumen de " & EmailSubject .htmlbody = RangetoHTML(rng) ' In place of the following statement, you can use ".Display" to ' display the e-mail message. .Display End With On Error GoTo 0 With Application .EnableEvents = True .ScreenUpdating = True End With Set OutMail = Nothing Set OutApp = Nothing ActiveSheet.Protect End Sub Function RangetoHTML(rng As Range) ' By Ron de Bruin. 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).PasteSpecial xlPasteAll .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 

Он отлично работает для отправки, но проблема при открытии. Таблица слишком широка для читателя

Есть ли что-то, что можно сделать, чтобы исправить это и иметь столбцы с той же шириной, что и в Excel?

благодаря

Я думаю, что код немного сложный, и с помощью этого кода вы можете вставлять только по почте значения выбранного диапазона …
Если вы хотите добавить ширину столбцов, вы можете добавить код:

 With TempWB.Sheets(1) .Cells(1).PasteSpecial xlPasteAll .Cells(1).Select Application.CutCopyMode = False On Error Resume Next .DrawingObjects.Visible = True .DrawingObjects.Delete On Error GoTo 0 End With ' Code ADDED i = 1 For Each xx In rng.Columns TempWB.Sheets(1).Columns(i).ColumnWidth = xx.ColumnWidth i = i + 1 Next ' Code ADDED '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 

только 5 строк между двумя блоками. Код устанавливает исходную ширину на новом листе (временный лист).
Для меня проще всего скопировать и вставить диапазон непосредственно в HTML-код почты. В этом случае у вас ВСЕ формат таблицы (пример: цвет, высота, шрифт …). Для этого часть кода может быть:

  Set mailApp = CreateObject("Outlook.Application") Set mail = mailApp.CreateItem(olMailItem) mail.Display mail.To = "[email protected]" mail.Subject = "subject" & Now Dim Clip As MSForms.DataObject Set Clip = New MSForms.DataObject Clip.SetText ("test ... body" & vbNewLine & vbNewLine _ & "this is another line " & vbCrLf _ & "this is another line again " & vbNewLine & " ") Clip.PutInClipboard Set wEditor = mailApp.ActiveInspector.wordEditor wEditor.Application.Selection.Paste Selection.Copy wEditor.Application.Selection.Paste ' mail.send 
  • VBA: Поиск электронной почты в почтовом ящике не по умолчанию?
  • Office 2013 - VBA Email не отображает переменные To / CC / BCC
  • Экспорт данных электронной почты Automail в Excel и обратно
  • Попытка открыть шаблон электронной почты Outlook с помощью excel VBA
  • Код Excel VBA для чтения имени пользователя из ячейки, затем отправьте электронное письмо этому пользователю
  • Добавить изображение в тело письма и подпись в Outlook через Excel-Vba
  • Вставить содержимое ячеек в Outlook, поддерживая форматирование
  • Копирование Вставка определенных ячеек Excel в автоматическую почтовую почту Outlook
  • Как сохранить исходный формат ячейки в макросе Excel?
  • Добавьте адрес электронной почты в сообщение электронной почты Outlook, если значение ячейки равно 1
  • Вставить Word.Document в тело электронной почты?
  • Давайте будем гением компьютера.