Ошибка определения приложения

Question

Я застрял в этой части кода от Рона де Бруина.

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).Value(11) = rng.Value(11) 
    .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), _ 
    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 

Эта строка возвращает ошибку:

With TempWB.PublishObjects.Add(_ 
    SourceType:=xlSourceRange, _ 
    Filename:=TempFile, _ 
    Sheet:=TempWB.Sheets(1), _ 
    Source:=TempWB.Sheets(1).UsedRange.Address, _ 
    HtmlType:=xlHtmlStatic) 
    .Publish (True) 
End With 

Application defined error or object defined error

Я не знаю, что происходит в этой части и искал вокруг сети о том, как преодолеть это, но не повезло достаточно. Любая помощь?

Answer 1

Я столкнулся с той же ошибкой из того же кода примера и смог исправить ее, сняв флажок Опции опций Excel> Формулы>R1C1.

Answer 2

Измените стиль ссылки в формате заголовка на тип символа из типа номера, что позволит решить проблему.

Изменить формат символов: (Используйте этот блок)

Public Sub SetDefaultReferenceStyleToCharacterFormat()

Application.ReferenceStyle = xlA1

End Sub

Изменить формат Номер: (Строка существования, которая вызывает ошибку)

Public Sub SetDefaultReferenceStyleToNumberFormat()

Application.ReferenceStyle = xlR1C1

End Sub

Answer 3

Чтобы исправить, я добавил Application.ReferenceStyle = xlA1 функции 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).Value(11) = rng.Value(11) 
    .Cells(1).Select 
    Application.CutCopyMode = False 
    On Error Resume Next 
    .DrawingObjects.Visible = True 
'  .DrawingObjects.Delete 
    On Error GoTo 0 
End With 

' Add this line 
Application.ReferenceStyle = xlA1 

'Publish the sheet to a htm file 
With TempWB.PublishObjects.Add(_ 
    SourceType:=xlSourceRange, _ 
    Filename:=TempFile, _ 
    Sheet:=TempWB.Sheets(1), _ 
    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