Zellinhalte in HTML verwandeln
rlx
In der Forums-FAQ werde ich aufgefordert, Feedback zu geben, ob ein Hinweis geholfen hat oder nicht, jedoch kann man ca. 5 Tage nach Erstellen eines Beitrages hier offenbar nicht mehr antworten, was ich erstens sehr ungewöhnlich, zweitens kommunikationserschwerend und drittens auch völlig bescheuert finde.
Das ist hier doch kein Allerwelts-Chat, wo das Geschreibsel am nächsten Tag schon keinen mehr interessiert, sondern ein Fachforum! Wozu diese Einschränkung?
So bin ich also gezwungen, für das Feedback einen neuen Thread zu eröffnen, welcher eigentlich keine Fragen, sondern nur meinen Lösungsweg enthält.
fcs (Franz) hatte zuletzt einen Vorschlag gemacht, der auf der Grundlage der RangeToHTML-Funktion von Ron de Bruin auch die Formate innerhalb von Zellen wiedergibt:
Function RangetoHTML1(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2010
' bearbeitet von fcs
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
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
rng.EntireColumn.Copy
'Spaltenbreiten kopieren
.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
.UsedRange.ClearFormats
'Zellbereich kopieren
rng.Copy .Cells(1, 1)
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)
RangetoHTML1 = ts.ReadAll
ts.Close
RangetoHTML1 = Replace(RangetoHTML1, "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
Sein Codebeispiel war für mich in dieser Form unbrauchbar, weil damit u.U. mehrere hundert leere HTML-Tabellenzellen erzeugt wurden. Das hängt wohl mit dem Befehl rng.EntireColumn.Copy und dem anschließenden .Cells(1, 1).PasteSpecial Paste:=xlPasteFormats zusammen, was wohl dazu gedacht war, die Spaltenbreiten exakt zu übertragen, was aber für mich nicht wichtig ist, da im Endeffekt nur ein String entstehen soll, der keine HTML-Tabellendefinitionen enthält.
Aber immerhin: Die abweichenden Formate innerhalb von Zellen wurden in HTML-verwandelt. Und das, obwohl fcs an der entscheidenden Stelle gar keine PasteSpecial-Methode anwendet: rng.Copy .Cells(1, 1).
So ganz hab ich das zwar noch nicht kapiert (die VBA-Hilfe ist bei der Beschreibung von PasteSpecial leider sehr oberflächlich), aber mit rng.copy und anschließendem .Cells(1, 1).PasteSpecial geht es auch.
Da ich die Funktion innerhalb meines Programms ca. 1000 mal aufrufe, hatte ich dann zunächst das Erstellen des temporären Workbooks nach "außen" verlagert, d.h. es wurde nur einmal ein temporäres Workbook erstellt, welches der Funktion als Referenz übergeben wurde, die den Inhalt nach verrichteter Arbeit wieder gelöscht hat. Dann fiel mir auf, dass dieses temporäre Workbook an sich überflüssig ist, man kann ja auch direkt den gewünschten Range aus der primären Tabelle in die HTML-Datei schreiben.
So blieb dann übrig:
Function RangetoHTML3(rng As Range) As String
' Changed by Ron de Bruin 28-Oct-2006
' zusammengestutzt von fcb und rlx
Dim wbt As Workbook
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
Set wbt = rng.Parent.Parent
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Zellbereich rng als HTML-Datei publizieren
With wbt.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=rng.Worksheet.Name, _
Source:=rng.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Daten aus temporärer HTML-Datei in Funktionsergebnis (String) schreiben
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML3 = ts.ReadAll
ts.Close
'Temporäre HTML-Datei schließen
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
Das Ergebnis ist ein String, der eine komplette HTML-Seite mit head und body darstellt, darin ist dann eine einzige Tabelle mit nur einer einzigen Zelle, deren Inhalt Formatierungen enthält, die aber über Style-Klassen realisiert werden. ....