2017-03-29 2 views
0

Wenn ich das Makro ichRangetoHTML nicht mehr arbeiten

Compile Error: Wrong number of arguements or invalid property assignment

die Function RangetoHTML(rng As Range) wird gelb hervorgehoben und das Format in der TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm" Linie markiert ist grau

Sub GenerateEmail() 

    Dim rng As Range 
    Dim OutApp As Object 
    Dim OutMail As Object 

    MsgBox "This will generate an email, please check Outlook" 

    Set rng = Sheets("ERC NPA").Range("B2:H23").SpecialCells(xlCellTypeVisible) 
    On Error GoTo 0 

    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 = "" 
     .CC = "" 
     .BCC = "" 
     .Subject = Range("G13") & " : Payment Request" 
     .HTMLBody = "Please find below payment request form" & RangetoHTML(rng) 
     .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) 

    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 
+1

Ich erhalte keine Kompilierungsfehler für Ihren Code. Welche Version von Excel verwenden Sie? Ein Problem, das ich sehen kann, ist, dass die 'RangetoHTML'-Funktion keinen Rückgabetyp angibt (aber standardmäßig' Variant', so dass es keinen Fehler gibt). – PeterT

+0

Ich sehe keine Probleme mit dem Code tatsächlich. Es läuft einfach gut mit einem Testblatt. –

+0

Es ist wirklich frustrierend, wie es früher gut funktionierte und in der letzten Woche hat es aufgehört zu arbeiten. Glaubst du, es könnte eine Version von Excel sein? Es muss eine Antwort geben – LogieBear

Antwort

0
Sub testFunction() 
' Try testing the function like this to pinpoint the problem 
' It works fine for me on Excel 2013 
' Cool function, btw 
Dim rng As Range 
Dim someString As String 

    Set rng = Sheets("ERC NPA").Range("B2:H23").SpecialCells(xlCellTypeVisible) 
    someString = RangetoHTML(rng) 
    Debug.Print someString 

Set rng = Nothing 
End Sub 
Verwandte Themen