Gruppe
Extern
Problem
Wie kann ich mit dem Autofilter gefilterte Daten so in einem HTMLDatei überführen, daß auch die Hyperlinks übernommen werden?
StandardModule: basMain
Sub Visible2HTML()
Dim rng As Range
Dim hyp As Hyperlink
Dim iRow As Integer, iCol As Integer, iFile As Integer
Dim sFile As String
Set rng = Range("A1").CurrentRegion
iFile = FreeFile
sFile = Application.Path & "\testhtml.htm"
Open sFile For Output As iFile
Print #iFile, "<html>"
Print #iFile, "<head>"
Print #iFile, "<title>Bedingte HTML-Übernahme</title>"
Print #iFile, "<style>"
Print #iFile, " th"
Print #iFile, " {"
Print #iFile, " font-family=tahoma,verdana;"
Print #iFile, " font-size=12px;"
Print #iFile, " font-weight=bold"
Print #iFile, " }"
Print #iFile, ""
Print #iFile, " td"
Print #iFile, " {"
Print #iFile, " font-family=tahoma,verdana;"
Print #iFile, " font-size=12px;"
Print #iFile, " }"
Print #iFile, "</style>"
Print #iFile, "<head>"
Print #iFile, "<body>"
Print #iFile, "<table border=1 cellpadding=3 cellspacing=1>"
Print #iFile, " <tr>"
For iCol = 1 To rng.Columns.Count
Print #iFile, " <th bgcolor=#ffffe0>" & Cells(1, iCol).Value & "</th>"
Next iCol
Print #iFile, " </tr>"
For iRow = 2 To rng.Rows.Count
If Rows(iRow).Hidden = False Then
Print #iFile, " <tr>"
For iCol = 1 To rng.Columns.Count
If Cells(iRow, iCol).Hyperlinks.Count > 0 Then
Set hyp = Cells(iRow, iCol).Hyperlinks(1)
End If
If hyp Is Nothing Then
Print #iFile, " <td>" & Cells(iRow, iCol).Value & "</td>"
Else
Print #iFile, " <td><a href=""" & hyp.Address & """>" & Cells(iRow, iCol).Value & "</a></td>"
End If
Set hyp = Nothing
Next iCol
Print #iFile, " </tr>"
End If
Next iRow
Print #iFile, "</table>"
Print #iFile, "</body>"
Print #iFile, "</html>"
Close iFile
Shell "explorer " & sFile, vbMaximizedFocus
End Sub
Sub a()
Close
End Sub