Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Fehler rangetohtml

Fehler rangetohtml
20.12.2021 20:22:45
Burkhard
Hallo Helfende,
ich habe mir hier im Forum etwas zusammengesucht und habe dabei den folgenden Code zusammengestellt.
Leider bekomme ich grundsätzlich die Meldung:
"Fehler beim Kompilieren:

Sub oder 

Function nicht definiert"
Mit dem Code sollen ein paar Zellen aus einer Tabelle kopiert
und in die Mail eingefügt werden.
Da ich nur wenig Grundkenntnisse habe erhoffe ich mir Hilfe.
Gruß Burkhard

Sub Email_generieren()
'Tabellenbereich einfügen'
Dim rng As Range
Set rng = Range("a9:f13")
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.GetInspector.Display
.To = Range("b1").Value
.CC = Range("b6").Value
.Subject = "Text " & Range("b7").Value
.HTMLBody = "Guten Morgen " & Range("b1").Value & "," & _
RangetoHTML(rng)
.Display
End With
End Sub
Anzeige

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Logisch...
20.12.2021 20:29:34
{Boris}
Hi,
...denn Du benötigst auch die Funktion rangetohtml.
Sie ist von Ron de Bruin - und zufälliger Weise habe ich sie hier parat ;-)

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
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
VG, Boris
Anzeige
AW: Logisch...
20.12.2021 21:08:09
Burkhard
Hallo Boris,
danke für die Blitzantwort.
Leider tun sich für mich wieder etliche Fragen auf.
1. brauche ich den Code zusätzlich zu meinem mit dem Mailversand?
2. wo definiere ich da den Bereich den ich einfügen will?
weil das Range("a9:f13") ist alles was ich brauche.
Gruß
Burkhard
Anzeige
AW: Logisch...
20.12.2021 21:29:06
volti
Hallo Burkhard,
spare Dir das mit dem RangetoHTML und kopiere den Bereich direkt, als Bereich oder als Bild, in Deine Mail.
Kannst auch gerne in diese Diskussion schauen, falls es doch Range2HTML sein soll:
https://www.ms-office-forum.net/forum/showpost.php?p=2051421&postcount=19
Code:

[Cc]

Sub Email_generieren() 'Tabellenbereich einfügen' Dim sMailtext As String ActiveSheet.Range("a9:f13").Copy With CreateObject("Outlook.Application").CreateItem(0) .GetInspector .To = Range("b1").Value .CC = Range("b6").Value .Subject = "Text " & Range("b7").Value sMailtext = "Guten Morgen, " & vbLf .htmlbody = sMailtext & .htmlbody With .GetInspector.WordEditor.Application.Selection .Start = Len(sMailtext) + 1 .Paste End With .Display End With End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

Anzeige
AW: Logisch...
20.12.2021 22:29:26
Burkhard
Hallo Karl Heinz,
ich muss nur die Zellen in die Mail haben... allerdings nicht als Bild.
Aber vom lesen und meinem Verständnis dürfte das mit deinem Vorschlag funktionieren.
Ich teste es morgen und berichte!
Gute Nacht.
AW: Logisch...
20.12.2021 23:04:49
volti
Hallo Boris,
nur so am Rande und es ist ja auch nicht gefragt, aber die RonDeBroin-Version übernimmt m.E. keine im Bereich liegenden Bilder.
Falls das mal vorkommen sollte. Ich hatte das schon mal als Anforderung.
Gruß KH
Anzeige
AW: Logisch...
21.12.2021 08:32:42
Burkhard
Hallo Karl-Heinz,
danke für deinen Code. Allerdings habe ich da noch einen Fehler, den ich selber nicht beheben kann.
Das mit dem Einfügen funktioniert nur dann, wenn vorher eine Mail händisch geöffnet wurde.
Dann sind die kopierten Zellen in der geöffneten Mail und der Text in einer zweiten Mail, die sich dann öffnet.
Aber schön kurz ist dein Code auf alle Fälle!
Danke.
Hallo Boris,
Dein Code funktioniert gut.
Ist zwar deutlich länger, aber das stört mich gerade nicht. ;-)
In dem Code verstehe ich pauschal nicht mal die Hälfte ;-) aber er funktioniert.
Auch dir danke.
Gruß Burkhard
Für alle die es auch nutzen möchten, es funktioniert, indem beide Codes in einem Modul sitze.

Sub Email_generieren()
'Tabellenbereich einfügen'
Dim rng As Range
Set rng = Range("a9:f13")
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.GetInspector.Display
.To = Range("b1").Value
.CC = Range("b6").Value
.Subject = "Text " & Range("b7").Value
.HTMLBody = "Guten Morgen " & Range("b1").Value & "," & _
RangetoHTML(rng)
.Display
End With
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
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function

Anzeige
AW: Logisch...
21.12.2021 12:01:21
volti
Hallo Burkhard,
Das mit dem Einfügen funktioniert nur dann, wenn vorher eine Mail händisch geöffnet wurde.
Kann ich nicht nachvollziehen, klappt bei mir bei offenem und geschlossenem Outlook...
Gruß KH
AW: Logisch...
21.12.2021 08:48:44
Luschi
Hallo Karl-Heinz,
bei mir muß ich folgende Änderungen vornehmen, damit Dein Code läuft:

Sub Email_generieren()
'Tabellenbereich einfügen'
Dim sMailtext As String
ActiveSheet.Range("a9:f13").Copy
With CreateObject("Outlook.Application").CreateItem(0)
.BodyFormat = 2   'wichtig, weil meine Signatur 1 Grafik enthält
.GetInspector
.To = Range("b1").Value
.CC = Range("b6").Value
.Subject = "Text " & Range("b7").Value
sMailtext = "Guten Morgen, " & "<br>"  'html-Code für neue Zeile
.htmlbody = sMailtext & .htmlbody
.Display    'hier und nicht nicht nach der With-Klausel
'sonst klappt .Start  innerhalb 'With' nicht
With .GetInspector.WordEditor.Application.Selection
.Start = Len(sMailtext) + 1
.Paste
End With
End With
Application.CutCopyMode = False 'Kopierbereich deaktivieren
End Sub
Gruß von Luschi
aus klein-Paris
PS: Grafiken innerhalb des Excel-Kopierbereiches werden mit in die E-Mail übernommen, eingeblendete Kommentare leider nicht!
Anzeige
AW: Logisch...
21.12.2021 09:25:33
Burkhard
Hallo, ein Zusatz noch.
.GetInspector.Display
Der funktioniert in der Version mit rangetohtml leider nicht.
Aber es gibt schlimmeres. ;-)
Die Version von Luschi habe ich (noch) nicht getestet.
Gruß Burkhard
AW: Logisch...
21.12.2021 13:09:38
volti
Hallo Luschi,
wohl wahr, da habe ich nicht aufgepasst und nach Veränderungen nicht noch mal getestet.
Danke für die Info.
Gruß KH
Anzeige
AW: Logisch...
20.12.2021 22:31:47
{Boris}
Hi,
unabhängig von der Antwort von Volti:
Der Code gehört in ein allgemeines Modul.
Mehr musst Du nicht machen. In Deinem geposteten Code rufst Du die Funktion ja mit A9:F13 (rng) auf:

.HTMLBody = "Guten Morgen " & Range("b1").Value & "," & _
RangetoHTML(rng)
Ich habe RangeToHtml selbst im Einsatz - und bin damit sehr zufrieden.
VG, Boris
Anzeige
AW: Logisch...
20.12.2021 22:24:05
Burkhard
Hallo Boris,
danke für die Blitzantwort.
Leider tun sich für mich wieder etliche Fragen auf.
1. brauche ich den Code zusätzlich zu meinem mit dem Mailversand?
2. wo definiere ich da den Bereich den ich einfügen will?
weil das Range("a9:f13") ist alles was ich brauche.
Gruß
Burkhard
Anzeige
;
Anzeige
Anzeige

Infobox / Tutorial

Fehler bei RangetoHTML in Excel VBA beheben


Schritt-für-Schritt-Anleitung

Um den Fehler "Sub oder Function nicht definiert" zu beheben, der beim Einsatz der RangetoHTML Funktion auftritt, folge diesen Schritten:

  1. VBA-Editor öffnen: Drücke ALT + F11 in Excel, um den VBA-Editor zu öffnen.

  2. Modul erstellen: Füge ein neues Modul hinzu, indem Du mit der rechten Maustaste auf "VBAProject (DeinWorkbookName)" klickst, dann "Einfügen" und "Modul" auswählst.

  3. Code einfügen: Kopiere den folgenden Code für die RangetoHTML Funktion in das Modul:

    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"
       rng.Copy
       Set TempWB = Workbooks.Add(1)
       With TempWB.Sheets(1)
           .Cells(1).PasteSpecial Paste:=8
           Application.CutCopyMode = False
       End With
       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
       Set fso = CreateObject("Scripting.FileSystemObject")
       Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
       RangetoHTML = ts.readall
       ts.Close
       TempWB.Close savechanges:=False
       Kill TempFile
    End Function
  4. Mailversand anpassen: Stelle sicher, dass Deine Email_generieren Subroutine die RangetoHTML Funktion korrekt aufruft:

    Sub Email_generieren()
       Dim rng As Range
       Set rng = Range("A9:F13")
       Dim objOutlook As Object
       Dim objMail As Object
       Set objOutlook = CreateObject("Outlook.Application")
       Set objMail = objOutlook.CreateItem(0)
       With objMail
           .To = Range("B1").Value
           .CC = Range("B6").Value
           .Subject = "Text " & Range("B7").Value
           .HTMLBody = "Guten Morgen " & Range("B1").Value & "," & RangetoHTML(rng)
           .Display
       End With
    End Sub
  5. Testen: Speichere Deine Änderungen und teste den Code, indem Du die Email_generieren Subroutine ausführst.


Häufige Fehler und Lösungen

  • Fehler: "Kopierbereich und Einfügebereich nicht die gleiche Größe"

    • Lösung: Stelle sicher, dass die Bereiche, die Du kopierst und einfügst, die gleiche Größe haben. Überprüfe die Range Objekte in Deinem Code.
  • Fehler: "Sub oder Function nicht definiert"

    • Lösung: Vergewissere Dich, dass die RangetoHTML Funktion im gleichen Modul wie die Email_generieren Subroutine oder in einem allgemein zugänglichen Modul definiert ist.

Alternative Methoden

Wenn Du Probleme mit der RangetoHTML Funktion hast, kannst Du auch versuchen, die Bereiche direkt in die E-Mail zu kopieren:

Sub Email_generieren()
    Dim rng As Range
    Set rng = Range("A9:F13")
    rng.Copy
    With CreateObject("Outlook.Application").CreateItem(0)
        .To = Range("B1").Value
        .CC = Range("B6").Value
        .Subject = "Text " & Range("B7").Value
        .GetInspector.WordEditor.Application.Selection.Paste
        .Display
    End With
End Sub

Praktische Beispiele

Beispiel 1: Verwende die RangetoHTML Funktion, um einen Excel-Bereich in eine HTML-E-Mail einzufügen. Achte darauf, dass die Funktion so definiert ist:

Function RangetoHTML(rng As Range)
    ' (Code wie oben einfügen)
End Function

Beispiel 2: Kopiere einen Bereich direkt als Bild in die E-Mail:

Sub Email_generieren()
    Dim rng As Range
    Set rng = Range("A9:F13")
    rng.CopyPicture
    With CreateObject("Outlook.Application").CreateItem(0)
        .To = Range("B1").Value
        .CC = Range("B6").Value
        .Subject = "Text " & Range("B7").Value
        .GetInspector.WordEditor.Application.Selection.Paste
        .Display
    End With
End Sub

Tipps für Profis

  • Verwende die On Error Resume Next Anweisung: Um Fehler beim Ausführen von VBA-Code zu ignorieren und den Code stabiler zu machen.
  • Optimierung der Leistung: Deaktiviere die Bildschirmaktualisierung während der Ausführung Deines Codes, um die Performance zu verbessern:

    Application.ScreenUpdating = False
    ' Dein Code hier
    Application.ScreenUpdating = True

FAQ: Häufige Fragen

1. Brauche ich die RangetoHTML Funktion zusätzlich zu meinem Code? Ja, die RangetoHTML Funktion ist erforderlich, um den kopierten Bereich in HTML umzuwandeln.

2. Wo definiere ich den Bereich, den ich einfügen will? Der Bereich wird in der Zeile Set rng = Range("A9:F13") definiert. Du kannst die Adresse anpassen, um den gewünschten Bereich zu ändern.

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige