Добавление таблицы PIVOT в электронную почту с использованием vba - PullRequest
0 голосов
/ 30 апреля 2020

Я пытаюсь добавить Pivot по почте, и да, я могу добавить его. Но проблема в Pivot в Excel и Pivot в Mail не совпадают. Тексты не выделены жирным шрифтом, которые уже выделены жирным шрифтом в Excel, а цвет фона заголовка и итога отсутствует в Mail.

Мой код:

Sub DailyControl_Mail()

  Dim rng As Range

  Dim OutApp As Object

  Dim OutMail As Object

  Dim signature As String

Dim StrBody1 As String



  StrBody1 = "Hi Team," & "<br><br>" & _

       "<br>"







         Set rng = Nothing

  On Error Resume Next

  'Only the visible cells in the selection

  'Set rng = Selection.SpecialCells(xlCellTypeVisible)

  'You can also use a fixed range if you want

  Set rng = ActiveSheet.Range("A1:E250").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)



With OutMail

  .Display

End With



  signature = OutMail.HTMLBody





  On Error Resume Next

  With OutMail

    .To = ""

    .CC = ""

    .BCC = ""

    .Subject = "Daily Control " & Format(Date, "MM DD YYYY")

    .HTMLBody = StrBody1 & RangetoHTML(rng) & vbNewLine & signature

    .Attachments.Add ActiveWorkbook.FullName

    '.Send  'or use

    .Display

  End With

  On Error GoTo 0



  With Application

    .EnableEvents = True

    .ScreenUpdating = True

  End With



  Set OutMail = Nothing

  Set OutApp = Nothing

End Sub





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

Я пытаюсь добавить Pivot в почта и да, я могу добавить это. Но проблема в Pivot в Excel и Pivot в Mail не совпадают. Тексты не выделены жирным шрифтом, которые уже выделены жирным шрифтом в Excel, а цвет фона заголовка и итога отсутствует в Mail.

Сводная таблица:

enter image description here

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...