ich habe als nicht VAB Experte eine, so hoffe ich, beschiedene Frage!
Vor geraumer Zeit habe ich das nachfolgende Marko gebraucht und bin sehr zufreiden mit den Ergebnissen!
Da ich aber zuwenig VAB kann und eine kleine Änderung benötige, möchte ich Euch Fragen wie man den ausgebenen Dateiname nicht nur von vorne mit den Pfadnamen beschränken kann sondern auch die ersten 10 Zeichen des Dateinamens.
Das Makro beschränkt zur Zeit den Dateinamen auf 15max. Zeichen (Dateiname) und würde dann die Zeichenfolge von 10ten bis zum 15 ten Zeichen ausgeben!
Damit hat der Hyperlink max 5 Zeichen.
Sub A_Hyperlink_einlesen_und_beschränken()
Dim iCount, i
Worksheets(1).Columns(1).Clear
With Application.FileSearch
.NewSearch
.LookIn = "C:\Test\test\"
'"D:\Programm- und Softwareinfo\Excel\Projekt Porsche\Lop Porsche"
'Verzeichnis zu hause
.Filename = "*.*"
.SearchSubFolders = False
.Execute
iCount = .FoundFiles.Count
For i = 1 To iCount
'For i= 1 die Auflistung wird ab dem ersten Verzeichnis/Dateiname durchgeführt
Worksheets(1).Hyperlinks.Add anchor:=Worksheets(1).Cells(i, 7).Range("a2"), TextToDisplay:= _
_
_
Dateiname_xlang(.FoundFiles(i)), Address:=.FoundFiles(i)
'Worksheets(1).Hyperlinks.Add anchor:=Worksheets(3)--> Arbeitsmappe 1
'Cells(i, 5) 5 --> Spalte E (1=A)
'Range("a3") --> Zeile 6
Next i
End With
Columns("G:G").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.ColumnWidth = 15
End Sub
Function Dateiname_xlang(pfad As String)
Dim position As Long
position = WorksheetFunction.Find("#", WorksheetFunction.Substitute(pfad, "\", "#", Len(pfad) - _
_
_
Len(WorksheetFunction.Substitute(pfad, "\", ""))))
pfad = Right(pfad, Len(pfad) - position) ' beschrängt die Zeichnenlänge auf der rechten Seite _
_
_
vollständig
pfad = Left(pfad, 15) ' beschrängt die Zeichnenlänge auf der linken Seite max. 15 Zeichen
Dateiname_xlang = pfad
End Function
Gruß
Lemmi