Bonjour Forum,
Voici mon sujet :
J'ai trouvé un code VBA sur le web qui me convient parfaitement excepté le fait que le résultat attendu s'applique sur la cellule active alors que mon souhait est de "fixer" le résultat sur les cellules A2 et B2 de la feuille 1.
Après plusieurs tentatives personnelles infructueuses, je me retourne vers vos compétences toujours efficaces !
Je vous joins le code en question et remercie d'avance pour ceux qui souhaiteraient s’intéresser à ce sujet.
Je peux également fournir un fichier exemple si nécessaire
Cdt
Nauj
Voici mon sujet :
J'ai trouvé un code VBA sur le web qui me convient parfaitement excepté le fait que le résultat attendu s'applique sur la cellule active alors que mon souhait est de "fixer" le résultat sur les cellules A2 et B2 de la feuille 1.
Après plusieurs tentatives personnelles infructueuses, je me retourne vers vos compétences toujours efficaces !
Je vous joins le code en question et remercie d'avance pour ceux qui souhaiteraient s’intéresser à ce sujet.
Je peux également fournir un fichier exemple si nécessaire
Cdt
Nauj
Code:
Private Sub Remplir(RepertParent, ExtFichier)
' Remplit la feuille courante avec le contenu du répertoire RepertParent
' Les noms de répertoires sont placés dans la colonne active à partir de
' la cellule active
' Les noms de fichiers correspondants à ExtFichier sont affichés dans la
' colonne de droite
' 14/02/2000 18:30, Gérard B, mpfe
Dim Compteur As Integer
Dim NbreRepert As Integer
Dim LeFichier As String
Dim LeDossier As String
Dim ExtLocale As String
Dim ParentLocal As String
Dim LeDossierLocal() As String
ExtLocale = ExtFichier
LeFichier = Dir(RepertParent & ExtFichier)
If Len(LeFichier) = 0 Then
ActiveCell.Value = RepertParent
ActiveCell.Offset(1, 0).Select
End If
Do While Len(LeFichier) <> 0
ActiveCell.Value = RepertParent
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = LeFichier
ActiveCell.Offset(1, -1).Select
LeFichier = Dir
Loop
'Compter le nombre de sous-répertoires
NbreRepert = 0
LeDossier = Dir(RepertParent, vbDirectory)
Do While LeDossier <> ""
If LeDossier <> "." And LeDossier <> ".." Then
If (GetAttr(RepertParent & LeDossier) _
And vbDirectory) = vbDirectory Then
NbreRepert = NbreRepert + 1
End If
End If
LeDossier = Dir
Loop
ReDim LeDossierLocal(NbreRepert + 1)
Compteur = 1
LeDossierLocal(Compteur) = Dir(RepertParent, vbDirectory)
Do While LeDossierLocal(Compteur) <> ""
If LeDossierLocal(Compteur) <> "." _
And LeDossierLocal(Compteur) <> ".." Then
If (GetAttr(RepertParent & LeDossierLocal(Compteur)) _
And vbDirectory) = vbDirectory Then
Compteur = Compteur + 1
End If
End If
LeDossierLocal(Compteur) = Dir
Loop
For Compteur = 1 To UBound(LeDossierLocal()) - 1
ParentLocal = RepertParent & LeDossierLocal(Compteur) & "\"
Call Remplir(ParentLocal, ExtLocale)
Next
End Sub