Gruppe
Extern
Bereich
HTML
Thema
HTML-Datei aus gefilterten Daten mit Hyperlinks aufbauen
Problem
Wie kann ich mit dem Autofilter gefilterte Daten so in einem HTMLDatei überführen, daß auch die Hyperlinks übernommen werden?
Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.
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