remplir une listbox avec des noms de fichier

[Philippe]

Bonsoir à tous,

j'ai besoin de connaitre tous les fichiers contenus dans un dossier, pour celà je les fait apparaitre dans une listbox avec le code suivant activé à partir d'un bouton:

Sub voir()
UserForm1.Show
Set fs = Application.FileSearch
repertoire = "C:\Documents and Settings\FILTEP\Mes documents\Mes images"
With fs
.LookIn = repertoire
.SearchSubFolders = True
.Filename = "*.*"
If .Execute > 0 Then
For x = 1 To .FoundFiles.Count
z = .FoundFiles(x)
nom = Right(z, Len(z) - 58) '<--- 58 = longueur de la chaine "C:\Documents..."
UserForm1.ListBox1.AddItem (nom)
Next
End If
End With
End Sub

La macro est activée à partir d'un bouton, le problème c'est qu'il faut activer deux fois de suite pour que la listbox se remplisse ou qu'elle prenne en compte les modifications effectuées dans le dossier "Mes image"... je n'en comprend pas la raison ???

donc au 1er click la listbox est vide (?), si on reclicke elle se remplit. Ensuite si on fait une modif dans "Mes images", on active la macro: la listbox se remplit avec les anciennes données (?), si on clicke une seconde fois, la listbox est cette fois bien mise à jour ...???

Merci de m'éclairer

A+
Philippe

 

[Spitnolan08]

Re : remplir une listbox avec des noms de fichier

Bonsoir,

Il faut que cette partie du code soit dans privatesub Userform_initialize

Set fs = Application.FileSearch
repertoire = "C:\Documents and Settings\Pierre-André\Bureau\Base\"
With fs
.LookIn = repertoire
.SearchSubFolders = True
.Filename = "*.*"
If .Execute > 0 Then
For x = 1 To .FoundFiles.Count
z = .FoundFiles(x)
nom = Right(z, Len(z) - 58) '<--- 58 = longueur de la chaine "C:\Documents..."
UserForm1.ListBox1.AddItem (nom)
Next
End If
End With

Cordialement

 

[noviceAG]

Re : remplir une listbox avec des noms de fichier

Bonsoir Spitolan08,
voici le code sur l'usf :

Private Declare Function GetWindowLongA Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long

Private Declare Function SetWindowLongA Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Private Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Sub Usf1_Initialize()
Dim hwnd As Long
hwnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", _
"X", "D") & "Frame", Me.Caption)
SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF
End Sub

Private Sub Usf1_Fermer()
Unload Usf1 'ou Me
End Sub


Le code dans un module :

Sub VerifStock()
Dim Diko As Object ' Je vais stocker le nom des feuilles à traiter
Dim CurCel As Range ' Cellule contenant le nom que je cherche
Dim CurTrouve As Range ' Cellule contenant le nom trouvé
Dim Forme As Shape ' Ma boîte d'attente

Dim FDep As String ' Feuille en cours
Dim FFin As String ' Feuille pour évaluer le stock
Dim Ws As Worksheet ' Pour manipuler aisément les feuilles du classeur

Usf1.Show
Call EffVerifStock
Set Diko = CreateObject("Scripting.Dictionary")
For Each CurCel In [A_Traiter] ' Scrute la plage nommée
If CurCel = "" Then Exit For ' Je suis au bout de la liste
Diko.Add UCase(CurCel.Value), UCase(CurCel.Value) ' Passe tout en majuscules : Moins de tracas
Next CurCel

If Diko.Count = 0 Then Exit Sub ' Si pas de feuilles à traiter je quitte


FFin = "Cde"
Set CurCel = Sheets(FFin).Range("B15")
Sheets(FFin).Range("G15:K" & Range("B65536").End(xlUp).Row).ClearContents
While CurCel <> "" ' Tant que l'on a quelque chose à chercher
For Each Ws In ThisWorkbook.Sheets ' Je regarde toutes les feuilles du classeur
If Diko.Exists(UCase(Ws.Name)) Then ' Feuille dans la liste donc je cherche
FDep = Ws.Name
With Sheets(FDep).Range("H2:IV2") ' Sur toute la ligne 2
Set CurTrouve = .Find(CurCel, LookIn:=xlValues, lookat:=xlWhole)
If Not CurTrouve Is Nothing Then ' Trouvé
If CurCel.Offset(0, 6) <> "" Then ' Déjà inscrit un nom de page
Cells(CurCel.Row, Range("IV" & CurCel.Row).End(xlToLeft).Column + 1) = Ws.Name
Else
CurCel.Offset(0, 6) = Ws.Name ' C'est le premier que j'inscrit
End If
Set CurTrouve = CurTrouve.Offset(-1, 0) ' Avec ces ###Grrr@@@ cellules fusionnées
CurCel.Offset(0, 5) = CurCel.Offset(0, 5) + CurTrouve.Offset(0, 3)
End If
End With
End If
Next Ws
Set CurCel = CurCel.Offset(1, 0) ' Se positionne sur la prochaine cellule à vérifier
Wend
Unload Usf1
End Sub

Je te remerci de me corriger

 

[noviceAG]

Re : remplir une listbox avec des noms de fichier

excuser-moi je me suis tromper de fil

 

[Philippe]

Re : remplir une listbox avec des noms de fichier

merci Spitnolan,

en effet tout marche bien comme celà.

Bonne soirée

A+
Philippe