Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
308to312
308to312
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Dateien eines Ordners als Hyperlink

Dateien eines Ordners als Hyperlink
13.09.2003 22:39:53
Ralf
Hallo,
wie kann ich die Excel Dateien eines Ordners als Hyperlink in einem Tabellenblatt angezeigt bekommen.Hab es schon mit FileSearch und anschließend
mit
For Each C In Selection
C.Hyperlinks.Add C
versucht, die Dateien werden auch als Hyperlink angezeigt bloß er funktioniert nicht bzw.der pfad im Hyperlink passt nicht.

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Dateien eines Ordners als Hyperlink
13.09.2003 22:42:22
Sorry doppelt
o.t.
AW: Dateien eines Ordners als Hyperlink
14.09.2003 10:25:36
GraFri
Hallo

Hab ich mal irgendwo gefunden.



Option Explicit

Sub DateienAuflisten()
    Dim FileArray(), Tb
    Dim VzPfad As String, DatTyp As String, DatName As String
    Dim As Integer, TBIndex As Integer, i As Integer
     On Error GoTo Fehler
     If ActiveWorkbook.ProtectStructure = False Then
Verzeichnispfad:
      VzPfad = InputBox("Geben Sie den Verzeichnispfad an." & _
               vbCrLf & vbCrLf & _
               "( Eingabeform: [Laufwerk] :\ [Verzeichnis] )", _
               "Dateiliste erstellen""F:\Eigene Dateien\Excel")
   If VzPfad = "" Then Exit Sub
      DatTyp = InputBox("Geben Sie den Dateityp an." & _
               vbCrLf & vbCrLf & _
               "( Eingabeform: [Datei-Extension], ' * ' für " & _
               "alle Dateien )""Dateiliste erstellen""xls")
   If DatTyp = "" Then Exit Sub
   If Dir(VzPfad, vbDirectory) = "" Then
      MsgBox "Verzeichnispfad ist falsch !  Das Verzeichnis" & _
              vbCrLf & "' " & VzPfad & " '" & _
              vbCrLf & "existiert nicht !", _
              vbExclamation, "Fehlermeldung"
 GoTo Verzeichnispfad
  End If
      Application.ScreenUpdating = False
      ChDrive Left(VzPfad, 1)
      ChDir VzPfad
      DatName = Dir("*." & DatTyp)
   Do While DatName <> ""
      n = n + 1
ReDim Preserve FileArray(1 To n)
      FileArray(n) = DatName
      DatName = Dir()
 Loop
   If n = 0 Then
      MsgBox "Es wurden keine Dateien dieses Typs gefunden !", _
             vbInformation, "Meldung"
 Exit Sub
  End If
      TBIndex = 1
  For Each Tb In Sheets
   If InStr(1, Tb.Name, "Dateiliste"Then
      TBIndex = TBIndex + 1
  End If
 Next Tb
 With Worksheets.Add
      .Move Before:=Worksheets(1)
      .Name = "Dateiliste (" & TBIndex & ")"
      .Cells.Font.Name = "Tahoma"
      .Cells.Font.Size = 8
      .Cells(5, 2).Font.Bold = True
      .Cells(5, 4).Font.Bold = True
      .Range(Cells(2, 2), Cells(3, 2)).Font.Bold = True
      .Range(Cells(7, 2), Cells(n + 6, 2)).Font.Bold = True
      .Range(Cells(7, 2), Cells(n + 6, 2)).HorizontalAlignment _
       = xlRight
      .Cells(5, 2).HorizontalAlignment = xlCenter
      .Columns(1).ColumnWidth = 2
      .Columns(2).ColumnWidth = 5
      .Columns(3).ColumnWidth = 1
  End With
 With ActiveWindow
      .DisplayGridlines = False
      .DisplayHeadings = False
  End With
  For i = 1 To n
 With ActiveSheet
      .Cells(2, 2).Value = "Dateiliste von Verzeichnis: " & _
       UCase(VzPfad)
      .Cells(3, 2).Value = "Dateityp: *." & UCase(DatTyp)
      .Cells(5, 2).Value = "- Nr. -"
      .Cells(5, 4).Value = "Datei (Name.Typ)"
      .Cells(i + 6, 2).Value = i & ")"
  End With
   If InStr(1, FileArray(i), ".XL", 1) Then
 With ActiveSheet
      .Hyperlinks.Add Anchor:=.Cells(i + 6, 4), Address:= _
       UCase(VzPfad & "\" & FileArray(i))
      .Cells(i + 6, 4).Value = UCase(FileArray(i))
      .Cells(i + 6, 4).Font.Name = "Tahoma"
      .Cells(i + 6, 4).Font.Size = 8
  End With
 Else
      ActiveSheet.Cells(i + 6, 4).Value = UCase(FileArray(i))
  End If
 Next i
 With ActiveSheet
      .Columns(4).EntireColumn.AutoFit
      .Range(Cells(7, 4), Cells(i + 6, 4)).Sort _
      Key1:=ActiveSheet.Range("D7"), Order1:=xlAscending
  End With
      Application.ScreenUpdating = True
      MsgBox "Es wurden " & n & " Dateien dieses Typs" & _
             vbCrLf & "gefunden, aufgelistet und sortiert.", _
             vbInformation, "Meldung"
 Else
      MsgBox "Die aktive Arbeitsmappe ist geschuetzt !" & _
             vbCrLf & "Routine kann nicht ausgefuehrt werden.", _
             vbExclamation, "Fehlermeldung"
  End If
 Exit Sub
Fehler:
Application.ScreenUpdating = True
MsgBox "Fehler !  Diese Routine wurde beendet." & _
       vbCrLf & Error, _
       vbExclamation, "Fehlermeldung"
End Sub

     Code eingefügt mit Syntaxhighlighter 2.4



mfg, GraFri
Anzeige
AW: Dateien eines Ordners als Hyperlink
14.09.2003 16:12:28
Ralf
Hallo GraFi,
ich hatte die Frage schon weiter unten gestellt und beantwortet bekommen.Ausversehen habe ich sie nochmal gepostet.
Trotzdem danke für deine Antwort
Ralf

322 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige