vba anpassung: Datei statt zwischenablage

Sub ExcelHtml()
'Convert the selection to HTML and copy result to clipboard
'See <a href="http://www.romankoch.ch/capslock/excelhtml.htm">http://www.romankoch.ch/capslock/excelhtml.htm</a> for more information
'Copyright Roman Koch 2005
'Constants to control the horizontal alignment within cells; use styles or stylesheet classes
Const cLeft = " style=""text-align: left;"""
Const cCenter = " style=""text-align: center;"""
Const cRight = " style=""text-align: right;"""
'DataObject requires a reference to the Microsoft Forms 2.0 Object Library
Dim oClip As DataObject
Dim rCell As Range, rRow As Range, rSelection As Range
Dim sTable As String
Dim sCell As String
Set rSelection = Application.Selection
Set oClip = New DataObject
sTable = "<table summary=""Converted from Microsoft Excel"">" & vbCrLf
'Iterate through each row of the selection
For Each rRow In rSelection.Rows
sTable = sTable & vbTab & "<tr>" & vbCrLf
'Iterate through each cell of the current row
For Each rCell In rRow.Cells
'Bold cells become header cells
If rCell.Font.Bold = True Then
sCell = "th"
Else
sCell = "td"
End If
sTable = sTable & vbTab & vbTab & "<" & sCell
'If the cell has no alignment, dates and numbers get right-aligned
If rCell.HorizontalAlignment = xlHAlignGeneral Then
If (IsNumeric(rCell.Text) Or IsDate(rCell.Text)) Then
sTable = sTable & cRight
End If
'otherwise, the user's alignment is used
Else
Select Case rCell.HorizontalAlignment
Case xlHAlignLeft: sTable = sTable & cLeft
Case xlHAlignCenter: sTable = sTable & cCenter
Case xlHAlignRight: sTable = sTable & cRight
End Select
End If
sTable = sTable & ">" & rCell.Text & "</" & sCell & ">" & vbCrLf
Next
sTable = sTable & vbTab & "</tr>" & vbCrLf
Next
sTable = sTable & "</table>"
'Copy sTable to the clipboard
oClip.SetText sTable
oClip.PutInClipboard
Set oClip = Nothing
MsgBox "Selection copied to the clipboard as HTML table", vbInformation, "Done"
End Sub