Re: hyperlink kopieren
27.01.2003 21:17:02
ivan
hi
der hyperlink ist nicht sichtbar also unterstrichen in der listbox man kann nur das sehen
zb.
No women no schrei - bob marleyda hast du mir dann folgenden code geschickt(der auch super passt nur der hypelink wird nicht kopiert sondern nur der
text des hyperlinks)
Private Sub CommandButton1_Click() Application.ScreenUpdating = False
Dim LoLetze As Long
With Worksheets("Tabelle3")
LoLetze = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
If LoLetze = 65536 Then
MsgBox "keine Zeile mehr frei"
Exit Sub
'Sheets("Tabelle3").Select
End If
.Range("G" & LoLetze + 1) = ListBox3.List(ListBox3.ListIndex, 0)
.Range("H" & LoLetze + 1) = ListBox3.List(ListBox3.ListIndex, 1)
.Range("I" & LoLetze + 1) = ListBox3.List(ListBox3.ListIndex, 2)
End With
End Sub
hier noch der code wie ich die hyperliks einlese!
Private Sub HYPERLINK_Click()
Application.ScreenUpdating = False
Dim strInitialDir As String, strPath As String
Dim sFile As String, sPattern As String, sPath As String
Dim iRow As Integer
Columns(1).ClearContents
sPath = BrowseDirectory()
If sPath = "" Then Exit Sub
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
'sPattern = InputBox(prompt:="Dateifilter:", Default:="*.mp3")
sFile = Dir(sPath & sPattern)
Do Until sFile = ""
iRow = iRow + 1
ActiveSheet.Hyperlinks.Add Anchor:=Cells(iRow, 1), _
Address:=sPath & sFile, TextToDisplay:=sFile
sFile = Dir()
Loop
End Sub
vieleicht kanst ma jetzt helfen
danke
ivan