Herbers Excel/VBA-Archiv
| Informationen und Beispiele zum Thema MsgBox | |
|---|---|
 Screenshot zu MsgBox |
MsgBox-Seite mit Beispielarbeitsmappe aufrufen |
Inhaltsverzeichnis mit Link
- Inhaltsverzeichnis mit Link von Ulrich vom 10.09.2020 14:14:34
- AW: in einer Kombination von PQ & HYPERLINK() ... - von neopa C am 10.09.2020 14:27:06
- AW: Inhaltsverzeichnis mit Link - von UweD am 10.09.2020 15:23:26
Geschrieben am: 10.09.2020 14:14:34
Hallo zusammen,
ich möchte gerne in einer Exceldatei „Inhaltsverzeichnis“ aus dem aktuellen Ordner oder aus Unterordner die Namen der vorhandenen Dateien in 4 Spalten aufgelistet haben.
Spalte B (Dateinamen die mit GB_ beginnen)
Spalte E (Dateinamen die mit BA_ beginnen)
Spalte H (Dateinamen die mit BG_ beginnen)
Spalte K (Dateinamen die mit XX_ beginnen)
die sollten Alphabetisch sortiert mit „Dateiname und Verlinkung zur Datei“ aufgelistet werden.
Die Dateien können Excel, Word oder auch pdf sein.
Hat vielleicht jemand eine Lösung für mich?
eine allgemeine Auflistung bekomme ich hin, aber mit der gewünschten Sortierung und einem zusätzlichen Link nicht.
Danke für eure Hilfe.
Gruß Ulli
Vielen Dank vorab.
Gruß Ulli
https://www.herber.de/bbs/user/140173.xlsx
von: neopa C
Geschrieben am: 10.09.2020 14:27:06
Hallo Ulli,
... sollte das realisierbar sein. Mehr zu PQ (PowerQuery) findest Du, wenn Du mal danach googelst. Zur Funktion HYPELINK() sieh die MSO-Hilfe
Gruß Werner
.. , - ...
von: UweD
Geschrieben am: 10.09.2020 15:23:26
Hallo
versuch es mal damit
Sub alle_Dateien_Verzeichnis() '
On Error GoTo Fehler
Dim Pfad As String, Ext1 As String, Ext2 As String, Ext3 As String
Dim Datei As String, Spalte As Integer, LR As Integer
Dim ArrSp, Z1 As Integer, i As Integer, RNG As Range
Pfad = "E:\Excel\Temp\" '**** mit \
Ext1 = ".xls"
Ext2 = ".doc"
Ext3 = ".pdf"
ArrSp = Array(1, 4, 7, 10) ' Zielspalten für die unterschiedlichen Dateinamen
' Array beginnt bei 0
Z1 = 4 'erste Zeile mit Daten
With Sheets("Tabelle1")
'reset
With .UsedRange.Offset(Z1 - 1)
.ClearContents
.Hyperlinks.Delete
End With
Datei = Dir(Pfad & "*.*")
Do While Len(Datei) > 0
'Nur xls,doc und pdf
If InStr(Datei, Ext1) > 0 Or InStr(Datei, Ext2) > 0 Or InStr(Datei, Ext3) > 0 Then
Select Case Left(Datei, 2) 'ersten 2 Zeichen von Dateiname
Case "GB"
Spalte = ArrSp(0)
Case "BA"
Spalte = ArrSp(1)
Case "BG"
Spalte = ArrSp(2)
Case "XX"
Spalte = ArrSp(3)
Case Else
Spalte = 0
End Select
If Spalte > 0 Then
LR = .Cells(.Rows.Count, Spalte).End(xlUp).Row + 1 'erste Freie Zeile der _
Spalte
.Cells(LR, Spalte) = WorksheetFunction.Max(.Columns(Spalte)) + 1 ' _
Nummerierung eintragen
.Cells(LR, Spalte + 1) = Datei ' Dateiname eintragen
.Hyperlinks.Add Anchor:=.Cells(LR, Spalte + 1), _
Address:=Pfad & Datei, TextToDisplay:=Datei
End If
End If
Datei = Dir() ' nächste Datei
Loop
For i = 0 To 3 ' Sortieren
LR = .Cells(.Rows.Count, ArrSp(i)).End(xlUp).Row
Set RNG = .Cells(Z1, ArrSp(i) + 1).Resize(LR - Z1 + 1, 1)
With .Sort
.SortFields.Clear
.SortFields.Add2 Key:=RNG, SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.SetRange RNG
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Next
End With
Err.Clear
Fehler:
If Err.Number <> 0 Then MsgBox "Fehler: " & _
Err.Number & vbLf & Err.Description: Err.Clear
End Sub
LG UweD