Répertoire

[Manon]

Bonsoir à tous

J'ai bien chercher dans le forum mais je n'ai rien trouvé qui s'applique à ce cas.

Est-il possible de ne pas montrer le chemin complet d'un répertoire. Je vous explique mon cas:

Sur ma feui1
J'ai une listbox1 avec un
listfillrange Feuil2!$A1:$A30
Sur ma feuil2
J'ai une liste crée avec une macro:

Sub lancer()
Dim noms_de_fichiers As Variant, i As Integer, y As Integer
Application.ScreenUpdating = False
ChDrive 'D' ChDir 'D:\\ClientsRemi' noms_de_fichiers = créer_liste_fichiers('*.xls')
Workbooks('teeest7.xls').Activate Sheets('Feuil2').Select Range('A1', Range('A1').End(xlDown)).Select
Selection.ClearContents
Range('A1').Select
blablabla...

ma listbox contient donc:
D:\\Clients\\client1.xls
D:\\Clients\\client2.xls
D:\\Clients\\client4.xls
D:\\Clients\\client5.xls
D:\\Clients\\client6.xls

Ce que je cherche à obtenir dans ma listbox1:

Client1
Client2
Client3

Merci

Manon

 

[ERIC S]

bonjour

si ton chemin est connu, tu connais le nombre de caractères avant la partie qui t'intéresse (clientx) donc en utilisant left, right, mid, len

exemple
en A1 j'ai : essai.xls

es1 = Mid(Range('A1').Value, 2, Len(Range('A1').Value) -5)

es1 donne ssai

A+

 

[Manon]

Bonjour à tous

Merci A+ pour ta réponse,

Y aurait-il un code, ou une macro à intégrer à mon code, pour automatiser ma listbox avec cette information.

Merci d'avance

Manon

 

[ERIC S]

Bonjour

ta macro qui crée la liste sour ta feuille 2 doit à un moment écrire entre A1 et A30, peut-être par une boucle où tu trouverais un

Range('A'& i).value = chemin de fichier

c'est à cet endroit qu'il faudrait faire

Range('A'& i).value = mid(...chemin de fichier..)

pour analyser plus il faudrait le code complet de ta macro lancer()

A+

 

[Manon]

Bonjour à tous

Merci ERIC mais je ne sais vraiment pas où le placer. Je t'envoi le code


'Solution de papou, mpfe (code à adapter suivant besoin)

Sub lancer()
Dim noms_de_fichiers As Variant, I As Integer, y As Integer

Application.ScreenUpdating = False

ChDrive 'D' 'Modifie la lettre du lecteur
ChDir 'D:\\Clients' 'Modifie le répertoire
noms_de_fichiers = créer_liste_fichiers('*.xls')

Workbooks('teeest7.xls').Activate 'Modifie le nom du classeur
Sheets('Feuil2').Select 'Modifie le nom de la feuille
Range('A1', Range('A1').End(xlDown)).Select
Selection.ClearContents
Range('A1').Select

For I = 1 To UBound(noms_de_fichiers)
Cells(I, 1).Formula = noms_de_fichiers(I)
Next I

Dim currentcell, nextcell
Set currentcell = Worksheets('Feuil1').Range('A1') 'Modifie le nom de la feuille
Do While Not IsEmpty(currentcell)
Dim nom_fichier
Set nextcell = currentcell.Offset(1, 0)
nom_fichier = currentcell.Value

For y = 1 To ActiveWorkbook.Sheets.Count

'Dans la ligne ci-dessous modifie éventuellemnt les noms de classeur et de feuille
Next y

Set currentcell = nextcell
Loop
Application.ScreenUpdating = True
Worksheets('FEUIL1').Select
End Sub

Public Function créer_liste_fichiers(Filtre As String)

'===========================================================================
'Fonction permettant de générer une liste des fichiers présents dans le
'répertoire courant
'Cette liste va être générée dans la procédure Lancer
'===========================================================================

Dim listefichiers() As String, comptefichier As Long
créer_liste_fichiers = ''
Erase listefichiers

If Filtre = '' Then Filtre = '*.xls,es1'
With Application.FileSearch
.NewSearch
.LookIn = CurDir
.Filename = Filtre
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute(SortBy:=msoSortByFileName, _
sortorder:=msoSortOrderAscending) = 0 Then Exit Function
ReDim listefichiers(.FoundFiles.Count)
For comptefichier = 1 To .FoundFiles.Count
listefichiers(comptefichier) = .FoundFiles(comptefichier)


Next comptefichier
.FileType = msoFileTypeExcelWorkbooks
End With
créer_liste_fichiers = listefichiers
Erase listefichiers
End Function


Merci de ta patience
Manon

 

[ERIC S]

re

je n'ai pas testé (il faudrait que j'adapte les chemins...) mais en première lecture je voterais pour

Cells(I, 1).Formula = noms_de_fichiers(I)

à modifier

Cells(I, 1).Formula = mid(noms_de_fichiers(I),ajuster position de début en fonction du nb de caractères de gauche à éliminer,len(noms_de_fichiers(I)- nb de caractères éliminés à gauche - nb caractères éliminés à droite))

Bons essais

 

[Manon]

Bonne journée à tous


SUPER!!!!

C'est exactement ce que je voulais.

Merci beaucoup
Manon