Hyperlink

Hallo,
ich lasse einen Ordner nach bestimmten Dateien durchsuchen und sie mir dann als Hyperlink anzeigen.Den Code dafür (hat mir jemand hier gepostet)mußte ich etwas abändern weil ich ansonsten die dateien als Hyperlink angezeigt bekam,aber beim anwählen geschah nichts.Hier der geänderte Teil des Code's:
For Each C In Selection
'IntPos = IntStrRev(C.Value, "\")
'strLink = Right(C.Value, Len(c) -IntPos)
C.Hyperlinks.Add C, C.Value ',TextToDisplay:=strLink
Das Problem ist jetzt das die Hyperlinks jetzt den gleichen Pfad haben wie das Fenster aus dem ich das Makro gestartet habe und wenn ich die Datei in den zu dursuchenden Ordner packe, werden die Blätter genauso minimiert wieder gegeben wie eben dieses Fenster.
Vielen Dank im voraus
Ralf

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Hyperlink

16.09.2003 21:54:15

Josef Ehrensberger

AW: Hyperlink

16.09.2003 22:37:38

Ralf

Hallo Ralf,

den Code hab ich auch mal hier im Forum gefunden.

Ich habe ihn ein wenig abgeändert.


Sub File_search_link()
Dim sDir As String
Dim rngPointer As Range
Dim C          As Range
Dim letzteZeile     As String
Dim intPos          As Integer
Dim strLink         As String
Dim pathLink        As String
Application.ScreenUpdating = False
pathLink = InputBox(Prompt:="Bitte geben Sie einen Pfad an!", _
Title:="Pfad eingeben", Default:="D:\Office\Excel")      'Suchpfad eingeben
If pathLink = Empty Then Exit Sub
If Right(pathLink, 1) <> "\" Then
pathLink = pathLink & "\"
End If
Range("A1:A200").ClearContents
Set rngPointer = ThisWorkbook.Worksheets(1).[A1] 'Ausgabezeiger positionieren
sDir = Dir(pathLink & "*.xls")
Do While sDir <> ""
rngPointer = sDir
Set rngPointer = rngPointer.Offset(1, 0)
sDir = Dir
Loop
letzteZeile = Range("A200").End(xlUp).Row   ' Bereich für Hypererstellung
Range("A2:A" & letzteZeile).Select           'Abgrenzung benutzte Zellen
[A1] = "Excel Arbeitsmappen in " & pathLink
For Each C In Selection
intPos = InStrRev(C.Value, "\")
strLink = Right(C.Value, Len(C) - intPos)
C.Hyperlinks.Add C, pathLink & strLink, TextToDisplay:=strLink
Next C
Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Columns("A:A").AutoFit
[A1].Select
Application.ScreenUpdating = True
End Sub

Vielleicht hilft dir das,
gruß Sepp

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread