Lister un répertoire sans les chemins

Dim NameSansExtension As String
Sub ListFichiers()
Dim NomFichier As String
    Set fs = Application.FileSearch
    With fs
        .NewSearch
        .SearchSubFolders = False
        .LookIn = "C:\excel"    '<- Chemin du répertoire
        .FileType = msoFileTypeAllFiles
        .Execute
        For I = 1 To .FoundFiles.Count    '<- Ecrit dans la feuille active
        ShortFilename (.FoundFiles(I))
            Range("A1").Offset(I, 0).Value = NameSansExtension 
        Next I
    End With
End Sub
Function ShortFilename(LongFilename As String) As String
    For I = Len(LongFilename) To 1 Step -1
        If Mid(LongFilename, I, 1) = "\" Then Exit For
    Next
    ShortFilename = Mid(LongFilename, I + 1, Len(LongFilename))
    NameSansExtension = Mid(ShortFilename, 1, Len(ShortFilename) - 4)
End Function

For i = 1 To .FoundFiles.Count '<- Ecrit dans la feuille active
t = Split(.FoundFiles(i), "\")
Range("A1").Offset(i, 0).Value = Split(t(UBound(t)), ".")(0)
Next i

Dim t

Sub ListFichiers()
Set fs = Application.FileSearch
With fs
.NewSearch
.SearchSubFolders = False
.LookIn = "D:\Mes documents\excel" '<- Chemin du répertoire
.FileType = msoFileTypeAllFiles
'.[B]FileType = msoFileTypeExcelWorkbooks 
'décommentez  cette ligne pour chercher uniquement des documents Excel[/B]
.Execute

For i = 1 To .FoundFiles.Count '<- Ecrit dans la feuille active
Range("A1").Offset(i, 0).Value =  _
 StrReverse(Left(StrReverse(.FoundFiles(i)), _
InStr(StrReverse(.FoundFiles(i)), "\") - 1))

Next i
End With
End Sub

Sub ListFichiers()
Dim x
Dim xx
Dim i As Integer
....debut du code
x = StrReverse(.FoundFiles(i))
xx = StrReverse(Left(x, InStr(x, "\") - 1))
Cells(i, 1) = Left(xx, Len(xx) - 4)
... fin du code
End Sub

Dim strNom As String
'
For i = 1 To .FoundFiles.Count
    strNom = .FoundFiles(i)
    Range("A1").Offset(i, 0).Value = _
               Left(Dir(strNom), Len(Dir(strNom)) - 4)
Next i