AW: Arbeitsblatt schützen - Hyperlinks auswählbar?
26.09.2011 22:36:33
fcs
Hallo Bernd,
der Makrorecorder in Excel 2007 zeichnet für viele Objekte den entsprechenden Code beim Erstellen und Formatieren nicht auf.
Nachfolgen ein Code für das Erstellen und Formatieren von Textboxen inkl. Hinzufügen eines Hyperlinks.
Gruß
Franz
' Erstellt unter Excel 2007
Sub AddTextboxen()
Dim wks As Worksheet, rngZelle As Range
Dim Zeile As Long, Spalte As Long
Dim sHL_Address As String
Set wks = ActiveSheet
With wks
'Hyperlinks in Zellen der Spalte 3 Zeilen 2 bis 10 auf Textboxen übertragen
Spalte = 3 'Spalte mit den Hyperlinks
For Zeile = 2 To 10
Set rngZelle = .Cells(Zeile, Spalte)
With rngZelle
If .Hyperlinks.Count > 0 Then
sHL_Address = rngZelle.Hyperlinks(1).Address 'Hyperlinkadresse
rngZelle.Hyperlinks(1).Delete
.Font.ColorIndex = xlColorIndexAutomatic
.Font.Underline = xlUnderlineStyleNone
Call AddTextboxwithHyperlink(Zelle:=rngZelle, sLink:=sHL_Address)
End If
End With
Next
' oder direkt einen Hyperlink zuweisen
Zeile = 3: Spalte = 1
sHL_Address = "C:\Users\Public\Test\_Code Julia20110915.txt" 'Hyperlinkadresse
Call AddTextboxwithHyperlink(Zelle:=.Cells(Zeile, Spalte), sLink:=sHL_Address)
End With
End Sub
Private Sub AddTextboxwithHyperlink(Zelle As Range, sLink As String)
'Textbox mit Größe der Zelle erstellen und Hyperlink zuordnen
Dim oShape As Shape
With Zelle.Parent '=Tabelenblatt der Zelle
Set oShape = .Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
Left:=Zelle.Left, Top:=Zelle.Top, Width:=Zelle.Width, Height:=Zelle.Height)
.Hyperlinks.Add Anchor:=oShape, Address:=sLink
With oShape
With .Line
.DashStyle = msoLineSolid
.ForeColor.RGB = RGB(0, 0, 0) 'schwarzer Rahmen
.Weight = 1
End With
With .TextFrame
.VerticalAlignment = xlVAlignCenter
.MarginTop = 0
.MarginBottom = 0
With .Characters
With .Font
.Size = 10
.Color = 16711680 'tiefblau
.Underline = xlUnderlineStyleSingle
End With
.Text = sLink
End With
End With
End With
End With
End Sub