Hyperlinks in Spalte ersetzen

  • Excel

Es gibt 1 Antwort in diesem Thema. Der letzte Beitrag () ist von Tony-S.

    Hyperlinks in Spalte ersetzen

    Hallo Forum,

    ich brauche mal eure Hilfe :)
    und zwar geht es darum, eine Excel-Arbeitsmappe als CSV zu speichern getrennt mit ";" - das geht auch schon.
    Ich habe in der Excel-Arbeitsmappe eine Spalte (immer nur eine z. B. "B") in der nur Hyperlinks sind.
    Diese Hyperlinks muss ich durch html a-Tags ersetzen, also so: <a href"www.google.de">google.de</a>.
    Meine Idee war, einfach nach "www" oder "http" zu suchen und die Zelle dann entsprechend anzupassen aber da es auch Hyperlinks (eigentlich nur) sind, funktioniert das so nicht. Meine nächste Idee war über ".Hyperlinks.Delete" den Link zu löschen, so dass nun nur noch Text da steht - geht ebenso nicht.

    Als nächstes habe ich versuch zu prüfen ob eine Zelle einen Hyperlink enthält und da hängt es bei mir.
    Ich brauche VBA eigentlich nur selten, wäre nett wenn mir jemand erklären kann, was zu tun ist und warum :)
    Der Fehler der auftritt, ist: "Index außerhalb des gültigen Bereichs", damit kann ich nicht so recht etwas anfangen. (in Zeile '<<<<<)

    MfG Tony

    Visual Basic-Quellcode

    1. 'Speichern mit ";" als Trennzeichen
    2. Sub SaveCSVSemicolon()
    3. Dim rngBereich As Range
    4. Dim rngZeile As Range
    5. Dim rngZelle As Range
    6. Dim strTemp As String
    7. Dim strPfad As String
    9. strPfad = ThisWorkbook.Path + "\"
    11. Const strDateiname As String = "csv2_file"
    12. Const strErweiterung As String = ".csv"
    13. Const strTrennzeichen As String = ";"
    15. Set rngBereich = ActiveSheet.UsedRange 'Nur die benutzten Zellen
    16. Open strPfad & strDateiname & strErweiterung For Output As #1
    18. For Each rngZeile In rngBereich.Rows
    19. For Each rngZelle In rngZeile.Cells
    20. 'Zellen, die ein "www" oder "http(s)" beinhalten in html a-Tags ändern
    21. If ((InStr(1, rngZelle.Text, "www") > 0) Or (InStr(1, rngZelle.Text, "http") > 0)) Then
    22. strTemp = strTemp & "<a href=""" & CStr(rngZelle.Text) & """>" & CStr(rngZelle.Text) & "</a>;"""
    23. 'Zellen, die einen Hyperlink enthalten ebenfalls ändern
    24. ElseIf (rngZelle.Hyperlinks(1).Count > 0) Then '<<<<<
    25. strTemp = strTemp & "<a href=""" & CStr(rngZelle.Hyperlinks(1).Address) & """>" & CStr(rngZelle.Hyperlinks(1).Address) & "</a>;"""
    26. 'Alle anderen Zellen nicht ändern
    27. Else
    28. strTemp = strTemp & CStr(rngZelle.Text) & strTrennzeichen
    29. End If
    31. Next
    32. Print #1, strTemp
    34. strTemp = ""
    35. Next
    37. Close #1
    38. Set rngBereich = Nothing
    39. End Sub

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Tony-S“ ()

    Hm hab es nun doch hinbekommen und es war, wie so oft,
    relativ einfach. Anstatt nach "www" oder "http(s)" zu suchen, suche ich nun nur noch nach Hyperlinks (wir gehen einfach mal davon aus, dass jede Zelle mit "www" oder "http(s)" auch ein Hyperlink ist). Ich gehe dazu wieder jede Zeile zellenweise durch und prüfe mit "Hyperlinks.Count" ob denn ein Hyperlink vorhanden ist, wenn ja wird dieser mit einem a-Tag umschlossen.

    Visual Basic-Quellcode

    1. Option Explicit
    3. 'Die folgende Prozedur speichert die geöffnete Arbeitsmappe in ein Simikolon getrenntes CSV-Dokument.
    4. 'Vorhandene Hyperlinks werden durch <a>-Tags ersetzt --> <a href="www.google.de">Google</a>
    5. Sub SaveCSV()
    6. Dim rngBereich As Range
    7. Dim rngZeile As Range
    8. Dim rngZelle As Range
    9. Dim strTemp As String
    10. Dim strPfad As String
    11. Dim strURL As String
    13. strPfad = ThisWorkbook.Path + "\" 'Speicherpfad, ist der Pfad in dem die Arbeitsmappe liegt
    15. Const strDateiname As String = "csv_file" 'Dateiname
    16. Const strErweiterung As String = ".csv" 'Dateierweiterung
    17. Const strTrennzeichen As String = ";" 'Trennzeichen
    19. Set rngBereich = ActiveSheet.UsedRange 'Nur die benutzten Zellen werden als Bereich genutzt
    20. Open strPfad & strDateiname & strErweiterung For Output As #1 'Datei öffnen
    21. For Each rngZeile In rngBereich.Rows
    22. For Each rngZelle In rngZeile.Cells
    23. 'Wenn ein Hyperlink gefunden wurde
    24. If rngZelle.Hyperlinks.Count > 0 Then
    25. strURL = "<a href=" & Chr(34) & rngZelle.Hyperlinks(1).Address & Chr(34) & ">" & rngZelle.Value & "</a>" & strTrennzeichen
    26. strTemp = strTemp & strURL
    27. 'Wenn kein Hyperlink gefunden wurde (alle anderen Inhalte)
    28. Else
    29. strTemp = strTemp & CStr(rngZelle.Text) & strTrennzeichen
    30. End If
    31. Next
    32. Print #1, strTemp 'Zeilenweise in Datei schreiben
    33. strTemp = ""
    34. Next
    36. Close #1 'Datei schließen
    37. Set rngBereich = Nothing
    38. End Sub


    Hoffentlich hilft das mal jemanden ;)