PublishObjects Calculating All Open Workbooks

[furt0414]

Hi All,

I am in desperate need of assistance. I have a macro that sends out ~200 reports on a daily basis, but it runs very slow because it calculates every time it hits the .Publish (True) line in Ron de Bruin's RangetoHTML function. Is there something I can add so that it will only calculate the active sheet?

Here's the code for reference:

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"
    Application.Calculation = xlCalculationManual
    '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

Any help is appreciated!!

 

[Syoodo]

Yes it can be changed. Do you still need help?

 

[furt0414]

Yes it can be changed. Do you still need help?

Syoodo,

Thanks for the response, I am still in need of help. For some reason it is no longer running as slow as it was when I originally posted, however anything I can do to speed up the code is a good thing! What tips do you have?

 

[Syoodo]

I believe I have some code that will help you out. To prevent any loss of data due to unforseen errors, test this code in a copy of your workbook. Replace the 'Publish the sheet to a htm file block of code with this code

'disable calculations on all sheets
For CounterVAR = 1 To ActiveWorkbook.Sheets.Count
    Sheets(CounterVAR).EnableCalculation = False
Next

'enable calculations on current sheet then calculate
ActiveSheet.EnableCalculation = True
ActiveSheet.Calculate 'you may not need this line

'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

'enable calculations on all sheets
For CounterVAR = 1 To ActiveWorkbook.Sheets.Count
    Sheets(CounterVAR).EnableCalculation = True
Next

I would also declare the counter variable by adding

Dim CounterVAR As Integer

to the other declared variables.

I believe this will work but I have not been able to fully test the code with your macro. I look forward to hearing about the results of your testing.