Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1804to1808
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro Hyperlink

Makro Hyperlink
08.01.2021 12:47:38
Mablu
Hallo
kann mir jemand helfen ich möchte eine Liste erstellen und bei der Eingabe der Texte soll nur die Spalte B2:B1000
den Text als Hyperlink ausgeben zB www.herber.de oder eine Mailadresse,
und alle anderen selbst erzeugten links im Aktiven Blatt sollte es löschen.
Jetzt wird mir in der ganzen Liste alle möglichen Text und Mailangeben als Hyperlink dargestellt?
Meine Suche nach einem Makro hat mich auf das gebracht
Public Sub Convert_To_Hyperlinks()
Dim Cell As Range
For Each Cell In Intersect(Selection, ActiveSheet.UsedRange)
If Cell  "" Then
ActiveSheet.Hyperlinks.Add Cell, Cell.Value
End If
Next
End Sub

aber das geht nicht richtig?
Für eure Hilfe besten dank

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro Hyperlink
08.01.2021 13:30:43
ChrisL
Hi
Public Sub Convert_To_Hyperlinks()
Dim Cell As Range
Cells.Hyperlinks.Delete
For Each Cell In Range("B2:B1000").Cells
If Cell  "" Then
ActiveSheet.Hyperlinks.Add Cell, Cell.Value
End If
Next
End Sub
cu
Chris
AW: Makro Hyperlink
08.01.2021 13:45:21
Mablu
Hallo Chris
Danke für das Makro, die Links werden erstellt nur bei den Mailadressen sucht er am Speicherort!
Nepumuk war so nett und hat mir eine 2. Variante gesendet diese Funktioniert.
Trotzdemschonen Tag und Danke
Gruss Mablu
AW: Makro Hyperlink
08.01.2021 13:35:07
Nepumuk
Hallo,
so ok?
Option Explicit

Public Sub Convert_To_Hyperlinks()
    Dim objCell As Range
    With ActiveSheet
        .Hyperlinks.Delete
        For Each objCell In .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
            If Not IsEmpty(objCell.Value) Then
                If InStr(1, objCell.Text, "@") > 0 Then
                    Call .Hyperlinks.Add(Anchor:=objCell, Address:="mailto:" & objCell.Text)
                Else
                    Call .Hyperlinks.Add(Anchor:=objCell, Address:=objCell.Text)
                End If
            End If
        Next
    End With
End Sub

Gruß
Nepumuk
Anzeige
AW: Makro Hyperlink_gelöst
08.01.2021 13:46:38
Mablu
Hallo Nepomuk
ja das klappt einwandfrei vielen Dank!
Gruss und schönes Wochenende
Mablu

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige