Рон де Брюин RangetoHTML с Mac - PullRequest
Новая
       6

Рон де Брюин RangetoHTML с Mac

0 голосов
/ 19 октября 2018

Я использую функцию RangetoHTML Рона де Брейна для создания ежедневного отчета о состоянии некоторых проектов для некоторых людей.Когда я использую лист Excel через компьютер Microsoft, все работает нормально, но, используя тот же скрипт VB на компьютере Mac, возникает ошибка.Я пытался найти в сети возможное решение, но оно, похоже, еще не решено, и мне сложно найти решение.

Таблица Excel состоит из 2 вкладок (PROJ1 и PROJ2) и содержит данные.в таблицах, указанных в диапазоне E5: F18 на вкладке PROJ1, и в диапазоне B1: E14 на вкладке PROJ2.Мне также нужен макет данных для преобразования в html (не только текстовое содержимое ячеек).

Поле E26 содержит тему электронного письма текущей вкладки, на которой скрипт называется Поле E27содержит адрес электронной почты поля «to» электронной почты. Поле E28 содержит адрес (а) электронной почты поля «cc» электронной почты

Вот код.У меня есть первый модуль, имеющий следующие инструкции: 

Private Sub Button1_Click()

Dim OutApp As Object, OutMail As Object

' Variable definition (variables to be passed to the RangetoHTML function)

' ****** TO BE MODIFIED IN CASE OF DIFFERENT STRUCTURE OF THE EXCEL ******
Dim rng As Range
Dim rng2 As Range

' ****** ---------------------------------------------------------- ******

' Body text definition
Dim StrBody As String


StrBody = "<html><body>Hi all,<br/>here a daily report for the progress status of all the activities.<br/><br/>Warning: activities in <b>BLOCKED</b> or in <b>WAITING INFORMATIONS</b> status are potentially dangerous for the project.</br></br></br></br></body></html>"

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set rng = Nothing
On Error Resume Next


' Setting the variables (here the range of data to be exported for each tab is defined

' ****** TO BE MODIFIED IN CASE OF DIFFERENT STRUCTURE OF THE EXCEL ******

Set rng = Sheets("PROJ1").Range("E5:F18").SpecialCells(xlCellTypeVisible)
Set rng2 = Sheets("PROJ2").Range("B1:E14").SpecialCells(xlCellTypeVisible)

' ****** ---------------------------------------------------------- ******

Subj = Range("E26").Value

On Error GoTo cleanup



        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
            .To = Range("E27").Value
            .CC = Range("E28").Value
            .Subject = Subj
            ' ****** TO BE MODIFIED IN CASE OF DIFFERENT STRUCTURE OF THE EXCEL ******
            .HTMLBody = StrBody & RangetoHTML(rng) & RangetoHTML(rng2)' <--- BUILD OF THE EMAIL'S BODY
            ' ****** ---------------------------------------------------------- ******

            .Display
        End With
        On Error GoTo 0
        Set OutMail = Nothing
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True

End Sub

2-й модуль - это функция RangetoHTML Рона де Брейна: 

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2013
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

Возвращена ошибка 429: компонент activex не можетсоздайте объект, а следующая часть будет выделена желтым цветом: 

'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

Операционная система - MacOS Sierra, а Excel - выпуск 2016 года.

Кто-нибудь знает, как ее решить?

...