Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1464to1468
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

Hyperlinks einfügen

Hyperlinks einfügen
17.12.2015 10:43:23
Gregor
Hallo
Mit folgendem Code möchte ich rund 900 Hyperlinks in bestehende Shapes einfügen, läuft aber _
sehr langsam, vermutlich wegen dem Select-Befehl. Geht das auch anders bzw. schneller?

Sub ChangeHyperlinks()
Dim Text  As Variant
Dim Zeile As Variant
Dim shp As Shape
Dim Adresse As Variant
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each shp In Worksheets("Muster").Shapes
If shp.AutoShapeType = msoShapeRoundedRectangle Then
shp.Select
Text = shp.Name
Worksheets("Textliste").Select
Zeile = Application.Match(Text, Columns(1), 0)
Adresse = Cells(Zeile, 5)
Worksheets("Muster").Select
shp.Hyperlink.Address = Adresse
End If
weiter:
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Wenn ich die jeweilige Seite nicht mit Select aufrufe, erhalte ich eine Fehlermeldung.
Danke und Gruss
Gregor

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

Betreff
Datum
Anwender
Anzeige
AW: Hyperlinks einfügen
17.12.2015 11:16:43
Beverly
Hi Gregor,
versuche es mal so:
Sub ChangeHyperlinks()
Dim Text  As Variant
Dim Zeile As Variant
Dim shp As Shape
Application.ScreenUpdating = False
For Each shp In Worksheets("Muster").Shapes
If shp.AutoShapeType = msoShapeRoundedRectangle Then
Text = shp.Name
Zeile = Application.Match(Text, Worksheets("Textliste").Columns(1), 0)
If IsNumeric(Zeile) Then
ActiveSheet.Hyperlinks.Add Anchor:=shp, Address:="", _
SubAddress:="Textliste!" & Cells(Zeile, 5).Address
End If
End If
Next
Application.ScreenUpdating = True
End Sub


Anzeige
AW: Hyperlinks einfügen
17.12.2015 12:02:21
Gregor
Hoi Karin
Mit diesem Code wird ein Hyperlink gesetzt, womit in die entsprechende Zeile, in der die Internetadresse steht, gesprungen wird. Ich möchte jedoch im form "Hyperlink bearbeiten" diese Internetadresse in die Adresse "Datei oder Webseite" eintragen (verlinken).
Was muss ich an deinem Code ändern?
Danke und Gruss
Gregor

AW: Hyperlinks einfügen
17.12.2015 12:13:11
Beverly
Hi Gregor,
sorry, das hatte ich anders verstanden.
So sollte es funktionieren:
Sub ChangeHyperlinks()
Dim Text  As Variant
Dim Zeile As Variant
Dim shp As Shape
Application.ScreenUpdating = False
For Each shp In Worksheets("Muster").Shapes
If shp.AutoShapeType = msoShapeRoundedRectangle Then
Text = shp.Name
With Worksheets("Textliste")
Zeile = Application.Match(Text, .Columns(1), 0)
If IsNumeric(Zeile) Then
If .Cells(Zeile, 5).Hyperlinks.Count > 0 Then
Worksheets("Muster").Hyperlinks.Add Anchor:=shp, _
Address:=.Cells(Zeile, 5).Hyperlinks(1).Address
End If
End If
End With
End If
Next
Application.ScreenUpdating = True
End Sub


Anzeige
AW: Hyperlinks einfügen
17.12.2015 13:59:03
Gregor
Hallo Karin
Super, vielen Dank, funktioniert super und SCHNELL.
Gruss Gregor

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige