Hyperlinks einfügen
17.12.2015 10:43:23
Gregor
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
Danke und Gruss
Gregor
Anzeige