hyperlinks

hallo ...

ich haette da gern mal ein problem in excel ...

also ... ich habe da 1.800 dateien in einem verzeichnis ... die da heissen at0001.dat ... at0002.dat ... at1800.dat ... diese 1.800 dateien wuerde ich gerne ... jede extra fuer sich ... als hyperlink in (logischerweise) 1.800 zellen eines excel arbeitsblattes bringen ...

mein erster versuch ... einfuegen hyperlink ... klick ... klick ... klick ... klick ... usw ... dann hab ich die erste datei als hyperlink ... und die geht dann auch auf, wenn ich in excel auf die zelle druecke ... alles ok ...

aber diese prozedur 1.800 mal ... ??? ...

ich hab mir das so vorgestellt ... ich fuege den dateinamen mit pfad in die zellen ... und konvertiere dann die zellen zu nem hyperlink ...

aaabbbeeerrr wie???

da braeuchte ich eure hilfe ...

danke im voraus ...

und viele gruesse ...

rainer

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: hyperlinks

12.11.2003 22:58:44

Josef Ehrensberger

Variante...

12.11.2003 23:03:35

Ramses

AW: hyperlinks

12.11.2003 23:05:49

xXx

hyperlinks ohne VBA

12.11.2003 23:13:41

Werner

hmmm schon alles da *g*

12.11.2003 23:27:27

chris-ka

AW: hyperlinks

13.11.2003 14:07:37

rainer2001

Hallo Rainer,

dieses Makro fügt eine Liste mit Hyperlinks zu allen
"*.xls" Files in eine Tabelle ein.
Ich hab das Makro mal hier im Forum entdeckt.
Den Pfad kannst du über eine Inputbox eingeben.


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:A2000").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("A2000").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

Gruß Sepp

Sub Create_Hyperlink_List_in_Table() Dim i As Long, totFiles As Long Dim gefFile As String, dname As String Dim Suchpfad As String, Suchbegriff As String, DateiForm As String Dim oldStatus As Variant Suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll.", "Pfad definieren", Application.DefaultFilePath) If Suchpfad = "" Then Exit Sub DateiForm = InputBox("Geben Sie den Dateityp an der gesucht werden soll", "Dateierweiterung", "*.xls") If DateiForm = "" Then Exit Sub Application.ScreenUpdating = True oldStatus = Application.StatusBar With Application.FileSearch .LookIn = Suchpfad .SearchSubFolders = True 'Durchsucht alle Unterordner oder =False .Filename = DateiForm If .Execute() > 0 Then totFiles = .FoundFiles.Count Application.StatusBar = "Total " & totFiles & " gefunden" For i = 1 To .FoundFiles.Count gefFile = .FoundFiles(i) Debug.Print gefFile dname = Right(gefFile, Len(gefFile) - InStrRev(gefFile, "\", -1, vbTextCompare)) Debug.Print dname 'In Tabelle in Spalte A eintragen Cells(i, 1).Hyperlinks.Add Anchor:=Cells(i, 1), Address:=Suchpfad & dname, TextToDisplay:=Suchpfad & dname Next i End If End With Application.StatusBar = oldStatus Application.ScreenUpdating = True End Sub

Sub Hyperlinks() With Application.FileSearch .LookIn = "C:\Test" .Filename = "at*.dat" If .Execute() > 0 Then For i = 1 To .FoundFiles.Count Cells(i, 1) = .FoundFiles(i) ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), Address:=.LookIn &"\" &.FoundFiles(i) Next i End If End With End Sub

Sub marine() Dim pfad As String Dim datei As String pfad = "c:\" 'hier anpassen datei = "*.dat" dateiname = Dir(pfad & datei) [a1].Select Do While dateiname <> "" dateiname = Dir ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=pfad & dateiname, TextToDisplay:=pfad & dateiname ActiveCell.Offset(1, 0).Select i = i + 1 Loop End Sub

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread