Bonjour,
Je souhaiterais obtenir dans une feuille excel, un menu déroulant avec la
liste des disque dur, dans une autre liste, l'arborescence des fichiers
dépendant du premier menu déroulant, et un bouton validation pour obtenir a
partir de la ligne "5" et en colonne "A" la liste de tous les fichiers du
dossier préselectionner.
Ensuite, je souhaite en colonne B, mettre une formule que je maitrise :) et
ensuite, une autre macro, pour renommer tous les fichier avec la valeur de
la colonne B.
Voila,
Merci beaucoup.
Bonjour,
Je souhaiterais obtenir dans une feuille excel, un menu déroulant avec la
liste des disque dur, dans une autre liste, l'arborescence des fichiers
dépendant du premier menu déroulant, et un bouton validation pour obtenir a
partir de la ligne "5" et en colonne "A" la liste de tous les fichiers du
dossier préselectionner.
Ensuite, je souhaite en colonne B, mettre une formule que je maitrise :) et
ensuite, une autre macro, pour renommer tous les fichier avec la valeur de
la colonne B.
Voila,
Merci beaucoup.
Bonjour,
Je souhaiterais obtenir dans une feuille excel, un menu déroulant avec la
liste des disque dur, dans une autre liste, l'arborescence des fichiers
dépendant du premier menu déroulant, et un bouton validation pour obtenir a
partir de la ligne "5" et en colonne "A" la liste de tous les fichiers du
dossier préselectionner.
Ensuite, je souhaite en colonne B, mettre une formule que je maitrise :) et
ensuite, une autre macro, pour renommer tous les fichier avec la valeur de
la colonne B.
Voila,
Merci beaucoup.
Bonjour,
Je souhaiterais obtenir dans une feuille excel, un menu déroulant avec la
liste des disque dur, dans une autre liste, l'arborescence des fichiers
dépendant du premier menu déroulant, et un bouton validation pour obtenir
a
partir de la ligne "5" et en colonne "A" la liste de tous les fichiers du
dossier préselectionner.
Ensuite, je souhaite en colonne B, mettre une formule que je maitrise :)
et
ensuite, une autre macro, pour renommer tous les fichier avec la valeur de
la colonne B.
Voila,
Merci beaucoup.
Bonjour,
Je souhaiterais obtenir dans une feuille excel, un menu déroulant avec la
liste des disque dur, dans une autre liste, l'arborescence des fichiers
dépendant du premier menu déroulant, et un bouton validation pour obtenir
a
partir de la ligne "5" et en colonne "A" la liste de tous les fichiers du
dossier préselectionner.
Ensuite, je souhaite en colonne B, mettre une formule que je maitrise :)
et
ensuite, une autre macro, pour renommer tous les fichier avec la valeur de
la colonne B.
Voila,
Merci beaucoup.
Bonjour,
Je souhaiterais obtenir dans une feuille excel, un menu déroulant avec la
liste des disque dur, dans une autre liste, l'arborescence des fichiers
dépendant du premier menu déroulant, et un bouton validation pour obtenir
a
partir de la ligne "5" et en colonne "A" la liste de tous les fichiers du
dossier préselectionner.
Ensuite, je souhaite en colonne B, mettre une formule que je maitrise :)
et
ensuite, une autre macro, pour renommer tous les fichier avec la valeur de
la colonne B.
Voila,
Merci beaucoup.
Salut Yves-Marie,
Voila ce que je t'ai bidouillé :
Mets sur ta feuille un ComboBox que tu nomme "CmbLecteurs", une ListeBox
que
tu nomme "LstDossiers" ensuite mets tout le code dans le module de la
feuille. Pour le test j'ai mis le remplissage du Combo pour les lecteurs
sur
Activate de la feuille donc change de feuille et revient ton Combo sera
plein. Un clic sur un dossier dans la liste t'inscris à partir de A5 les
fichiers Excel du dossier. Un double clic ouvre le dossier et affiche les
sous-dossiers avec un décalage un double-clic sur le dossier parent
remonte
dans arborescence. Je n'ai plus le temps de chercher pour le moment
comment
renommer tous les classeurs sans les ouvrir. Je verrai demain. Pour le
moment, teste et dis moi si cela te convient. Attention, j'utilise la
cellule [A1] pour afficher le chemin complet du dossier ouvert Adapte si
cela te dérange. Fait le test sur un classeur vierge.
Private Declare Function LesLecteurs Lib _
"kernel32" Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
'à mettre dans ThisWorkbook.Open
'pour avoir tous les lecteurs
'à l'ouverture du classeur
'l'appel :
'>Private Sub Workbook_Open()
'>Feuil1.Lecteurs
'>End Sub
'Je l'ai mis ici pour les tests
Private Sub Worksheet_Activate()
Lecteurs
End Sub
Private Sub CmbLecteurs_Click()
With Me
.LstDossiers.Clear
CheminComplet .CmbLecteurs.Value, False
Dossiers [A1]
ChargerFichiers .CmbLecteurs.Value
End With
End Sub
Private Sub LstDossiers_Click()
Dim I As Integer
Dim Chemin As String
Dim NomDossier As String
Range("A5:A" & Range("A5").End(xlDown).Row).Clear
With Me
Chemin = [A1]
With .LstDossiers
'si le dossier est un sous dossier (5 espaces à gauche)
'rajoute au chemin le nom du dossier sélectionné
If Left(.Value, 5) = Space(5) Then
Chemin = Chemin & Trim(.Value) & ""
Else
'si le chemin indique seulement le lecteur, rajoute
'le dossier sélectionné
If Len(Chemin) = 3 Then
Chemin = Chemin & .Value & ""
End If
End If
End With
End With
ChargerFichiers Chemin
End Sub
Private Sub LstDossiers_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim DosParent As String
On Error Resume Next
With Me.LstDossiers
If .ListIndex = 0 Then
If Err = 0 Then
DossierParent
Exit Sub
End If
End If
End With
On Error GoTo 0
'récupère le dossier parent, le recharge après avoir
'vidé la ListBox. Défini le chemin et appelle la
'proc SousDossiers pour charger les sousdossiers
'et les mettre en décalés
With Me.LstDossiers
DosParent = Trim(.Value)
.Clear
.AddItem DosParent
CheminComplet DosParent, True
SousDossiers [A1], DosParent
End With
Range("A5:A" & Range("A5").End(xlDown).Row).Clear
'charge les fichiers du dossier parent
ChargerFichiers [A1]
End Sub
Public Sub Lecteurs()
Dim LstLecteur As String
Dim Retour As Long
Dim I As Integer
Const LecteurDef As String = "C:" 'lecteur par défaut
'récup de la liste des lecteurs
LstLecteur = String(50, Chr$(0))
Retour = LesLecteurs(50, LstLecteur)
CmbLecteurs.Clear
For I = 1 To Len(LstLecteur)
If Mid(LstLecteur, I, 1) = "" Then
CmbLecteurs.AddItem UCase(Mid(LstLecteur, I - 2, 3))
End If
Next I
[A1] = LecteurDef
CmbLecteurs.Value = LecteurDef
End Sub
Private Sub Dossiers(Chemin As String)
Dim Dossier As String
Dim Tbl()
Dim I As Integer
'évite l'erreur du lecteur CD vide
'et plus bas, le tableau non initialisé
'dû à une disquette ou CD vierge
On Error Resume Next
Dossier = Dir(Chemin, 16)
If Err.Number <> 0 Then Exit Sub
Do While Dossier <> ""
If Dossier <> "." And Dossier <> ".." Then
If (GetAttr(Chemin & Dossier) _
And 16) = 16 Then
I = I + 1
ReDim Preserve Tbl(1 To I)
Tbl(I) = Dossier
End If
End If
Dossier = Dir
Loop
TriTableau Tbl()
'charge la listbox
Me.LstDossiers.List = Tbl()
Erase Tbl
End Sub
Sub TriTableau(Tbl())
Dim Tempo
Dim I As Integer
Dim J As Integer
'éffectue un tri
'croissant du tableau
For I = 1 To UBound(Tbl) - 1
For J = I + 1 To UBound(Tbl)
If Trim(Tbl(I)) > Trim(Tbl(J)) Then
Tempo = Tbl(J)
Tbl(J) = Tbl(I)
Tbl(I) = Tempo
End If
Next J
Next I
End Sub
Private Sub SousDossiers(Chemin As String, _
Optional DosParent As String)
Dim Tbl()
Dim Dossier As String
Dim I As Integer
'récupère les dossiers pour le chemin spécifié
'insére pour chaque sous-dossier 5 espaces avant
'afin de les démarquer du dossier parent en les
'décalant vers la droite
Dossier = Dir(Chemin, 16)
Do While Dossier <> ""
If Dossier <> "." And Dossier <> ".." Then
If (GetAttr(Chemin & Dossier) _
And 16) = 16 Then
I = I + 1
ReDim Preserve Tbl(1 To I)
Tbl(I) = Space(5) & Dossier
'Me.LstDossiers.AddItem Space(5) & Dossier
End If
End If
Dossier = Dir
Loop
On Error Resume Next
TriTableau Tbl()
'charge la listbox
For I = 1 To UBound(Tbl)
Me.LstDossiers.AddItem Tbl(I)
Next
Erase Tbl
End Sub
Sub ChargerFichiers(Chemin As String)
Dim Fichier As String
Dim FS As FileSearch
Dim I As Integer
Dim J As Integer
'vide les cellules
Range("A5:A" & Range("A5").End(xlDown).Row).Clear
'effectue la recherche
With Me
Set FS = Application.FileSearch
With FS
.LookIn = Chemin
.Filename = "*.xls" 'seulement Excel
If .Execute > 0 Then
J = 5
For I = 1 To .FoundFiles.Count
Range("A" & J) = Dir(.FoundFiles(I))
J = J + 1
Next I
End If
End With
End With
Set FS = Nothing
End Sub
Private Sub CheminComplet(Dossier As String, SousDossier As Boolean)
Dim I As Integer
Dim Chemin As String
Dim DosCourrant As String
Dim Lecteur As Boolean
'cherche si le dossier est le lecteur
'si il l'est, attribut la valeur de la variable
'Dossier à la variable Chemin, sinon, défini
'le chemin
Lecteur = Dossier Like "?:"
If Lecteur = False Then
Chemin = [A1]
'recherche le nom du dossier ouvert
For I = Len(Chemin) - 1 To 3 Step -1
If Mid(Chemin, I, 1) = "" Then
DosCourrant = Mid(Chemin, I + 1, Len(Chemin) - (I + 1))
Exit For
End If
Next I
If I < 3 Then I = 3
'si le dossier est différent, éffectue le changement
'ou le rajoute en fonction de la valeur de la variable
'SousDossier
If Dossier <> DosCourrant Then
If SousDossier = False Then
Chemin = Left(Chemin, I) & Dossier & ""
Else
Chemin = Chemin & Dossier & ""
End If
Else
Chemin = Chemin
End If
Else
Chemin = Dossier
End If
'défini la cellule qui sert pour la recherche
'et l'information sur le dossier ouvert
[A1] = Chemin
End Sub
Private Sub DossierParent()
Dim I As Integer
Dim J As Integer
Dim Chemin As String
Dim DosParent As String
Chemin = [A1]
'si le chemin ne contient pas que le lecteur
'recherche la barre de séparation
If Len(Chemin) > 3 Then
For I = Len(Chemin) - 1 To 3 Step -1
If Mid(Chemin, I, 1) = "" Then
Exit For
End If
Next I
'recherche le dossier parent
For J = I - 1 To 3 Step -1
If Mid(Chemin, J, 1) = "" Then
DosParent = Mid(Chemin, J + 1, (I - 1) - J)
Exit For
End If
Next J
Else
'défini I à 3 pour le lecteur
I = 3
End If
With Me
.LstDossiers.Clear
[A1] = Left(Chemin, I)
If DosParent <> "" Then
.LstDossiers.AddItem DosParent
SousDossiers [A1]
Else
Dossiers [A1]
End If
ChargerFichiers [A1]
If Len([A1]) <> 3 Then
.LstDossiers.ListIndex = 0
End If
End With
End Sub
Hervé.
"Yves-Marie BIERSOHN" a écrit
dans le message news:Bonjour,
Je souhaiterais obtenir dans une feuille excel, un menu déroulant avec
la
liste des disque dur, dans une autre liste, l'arborescence des fichiers
dépendant du premier menu déroulant, et un bouton validation pour
obtenir
apartir de la ligne "5" et en colonne "A" la liste de tous les fichiers
du
dossier préselectionner.
Ensuite, je souhaite en colonne B, mettre une formule que je maitrise :)
etensuite, une autre macro, pour renommer tous les fichier avec la valeur
de
la colonne B.
Voila,
Merci beaucoup.
Salut Yves-Marie,
Voila ce que je t'ai bidouillé :
Mets sur ta feuille un ComboBox que tu nomme "CmbLecteurs", une ListeBox
que
tu nomme "LstDossiers" ensuite mets tout le code dans le module de la
feuille. Pour le test j'ai mis le remplissage du Combo pour les lecteurs
sur
Activate de la feuille donc change de feuille et revient ton Combo sera
plein. Un clic sur un dossier dans la liste t'inscris à partir de A5 les
fichiers Excel du dossier. Un double clic ouvre le dossier et affiche les
sous-dossiers avec un décalage un double-clic sur le dossier parent
remonte
dans arborescence. Je n'ai plus le temps de chercher pour le moment
comment
renommer tous les classeurs sans les ouvrir. Je verrai demain. Pour le
moment, teste et dis moi si cela te convient. Attention, j'utilise la
cellule [A1] pour afficher le chemin complet du dossier ouvert Adapte si
cela te dérange. Fait le test sur un classeur vierge.
Private Declare Function LesLecteurs Lib _
"kernel32" Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
'à mettre dans ThisWorkbook.Open
'pour avoir tous les lecteurs
'à l'ouverture du classeur
'l'appel :
'>Private Sub Workbook_Open()
'>Feuil1.Lecteurs
'>End Sub
'Je l'ai mis ici pour les tests
Private Sub Worksheet_Activate()
Lecteurs
End Sub
Private Sub CmbLecteurs_Click()
With Me
.LstDossiers.Clear
CheminComplet .CmbLecteurs.Value, False
Dossiers [A1]
ChargerFichiers .CmbLecteurs.Value
End With
End Sub
Private Sub LstDossiers_Click()
Dim I As Integer
Dim Chemin As String
Dim NomDossier As String
Range("A5:A" & Range("A5").End(xlDown).Row).Clear
With Me
Chemin = [A1]
With .LstDossiers
'si le dossier est un sous dossier (5 espaces à gauche)
'rajoute au chemin le nom du dossier sélectionné
If Left(.Value, 5) = Space(5) Then
Chemin = Chemin & Trim(.Value) & ""
Else
'si le chemin indique seulement le lecteur, rajoute
'le dossier sélectionné
If Len(Chemin) = 3 Then
Chemin = Chemin & .Value & ""
End If
End If
End With
End With
ChargerFichiers Chemin
End Sub
Private Sub LstDossiers_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim DosParent As String
On Error Resume Next
With Me.LstDossiers
If .ListIndex = 0 Then
If Err = 0 Then
DossierParent
Exit Sub
End If
End If
End With
On Error GoTo 0
'récupère le dossier parent, le recharge après avoir
'vidé la ListBox. Défini le chemin et appelle la
'proc SousDossiers pour charger les sousdossiers
'et les mettre en décalés
With Me.LstDossiers
DosParent = Trim(.Value)
.Clear
.AddItem DosParent
CheminComplet DosParent, True
SousDossiers [A1], DosParent
End With
Range("A5:A" & Range("A5").End(xlDown).Row).Clear
'charge les fichiers du dossier parent
ChargerFichiers [A1]
End Sub
Public Sub Lecteurs()
Dim LstLecteur As String
Dim Retour As Long
Dim I As Integer
Const LecteurDef As String = "C:" 'lecteur par défaut
'récup de la liste des lecteurs
LstLecteur = String(50, Chr$(0))
Retour = LesLecteurs(50, LstLecteur)
CmbLecteurs.Clear
For I = 1 To Len(LstLecteur)
If Mid(LstLecteur, I, 1) = "" Then
CmbLecteurs.AddItem UCase(Mid(LstLecteur, I - 2, 3))
End If
Next I
[A1] = LecteurDef
CmbLecteurs.Value = LecteurDef
End Sub
Private Sub Dossiers(Chemin As String)
Dim Dossier As String
Dim Tbl()
Dim I As Integer
'évite l'erreur du lecteur CD vide
'et plus bas, le tableau non initialisé
'dû à une disquette ou CD vierge
On Error Resume Next
Dossier = Dir(Chemin, 16)
If Err.Number <> 0 Then Exit Sub
Do While Dossier <> ""
If Dossier <> "." And Dossier <> ".." Then
If (GetAttr(Chemin & Dossier) _
And 16) = 16 Then
I = I + 1
ReDim Preserve Tbl(1 To I)
Tbl(I) = Dossier
End If
End If
Dossier = Dir
Loop
TriTableau Tbl()
'charge la listbox
Me.LstDossiers.List = Tbl()
Erase Tbl
End Sub
Sub TriTableau(Tbl())
Dim Tempo
Dim I As Integer
Dim J As Integer
'éffectue un tri
'croissant du tableau
For I = 1 To UBound(Tbl) - 1
For J = I + 1 To UBound(Tbl)
If Trim(Tbl(I)) > Trim(Tbl(J)) Then
Tempo = Tbl(J)
Tbl(J) = Tbl(I)
Tbl(I) = Tempo
End If
Next J
Next I
End Sub
Private Sub SousDossiers(Chemin As String, _
Optional DosParent As String)
Dim Tbl()
Dim Dossier As String
Dim I As Integer
'récupère les dossiers pour le chemin spécifié
'insére pour chaque sous-dossier 5 espaces avant
'afin de les démarquer du dossier parent en les
'décalant vers la droite
Dossier = Dir(Chemin, 16)
Do While Dossier <> ""
If Dossier <> "." And Dossier <> ".." Then
If (GetAttr(Chemin & Dossier) _
And 16) = 16 Then
I = I + 1
ReDim Preserve Tbl(1 To I)
Tbl(I) = Space(5) & Dossier
'Me.LstDossiers.AddItem Space(5) & Dossier
End If
End If
Dossier = Dir
Loop
On Error Resume Next
TriTableau Tbl()
'charge la listbox
For I = 1 To UBound(Tbl)
Me.LstDossiers.AddItem Tbl(I)
Next
Erase Tbl
End Sub
Sub ChargerFichiers(Chemin As String)
Dim Fichier As String
Dim FS As FileSearch
Dim I As Integer
Dim J As Integer
'vide les cellules
Range("A5:A" & Range("A5").End(xlDown).Row).Clear
'effectue la recherche
With Me
Set FS = Application.FileSearch
With FS
.LookIn = Chemin
.Filename = "*.xls" 'seulement Excel
If .Execute > 0 Then
J = 5
For I = 1 To .FoundFiles.Count
Range("A" & J) = Dir(.FoundFiles(I))
J = J + 1
Next I
End If
End With
End With
Set FS = Nothing
End Sub
Private Sub CheminComplet(Dossier As String, SousDossier As Boolean)
Dim I As Integer
Dim Chemin As String
Dim DosCourrant As String
Dim Lecteur As Boolean
'cherche si le dossier est le lecteur
'si il l'est, attribut la valeur de la variable
'Dossier à la variable Chemin, sinon, défini
'le chemin
Lecteur = Dossier Like "?:"
If Lecteur = False Then
Chemin = [A1]
'recherche le nom du dossier ouvert
For I = Len(Chemin) - 1 To 3 Step -1
If Mid(Chemin, I, 1) = "" Then
DosCourrant = Mid(Chemin, I + 1, Len(Chemin) - (I + 1))
Exit For
End If
Next I
If I < 3 Then I = 3
'si le dossier est différent, éffectue le changement
'ou le rajoute en fonction de la valeur de la variable
'SousDossier
If Dossier <> DosCourrant Then
If SousDossier = False Then
Chemin = Left(Chemin, I) & Dossier & ""
Else
Chemin = Chemin & Dossier & ""
End If
Else
Chemin = Chemin
End If
Else
Chemin = Dossier
End If
'défini la cellule qui sert pour la recherche
'et l'information sur le dossier ouvert
[A1] = Chemin
End Sub
Private Sub DossierParent()
Dim I As Integer
Dim J As Integer
Dim Chemin As String
Dim DosParent As String
Chemin = [A1]
'si le chemin ne contient pas que le lecteur
'recherche la barre de séparation
If Len(Chemin) > 3 Then
For I = Len(Chemin) - 1 To 3 Step -1
If Mid(Chemin, I, 1) = "" Then
Exit For
End If
Next I
'recherche le dossier parent
For J = I - 1 To 3 Step -1
If Mid(Chemin, J, 1) = "" Then
DosParent = Mid(Chemin, J + 1, (I - 1) - J)
Exit For
End If
Next J
Else
'défini I à 3 pour le lecteur
I = 3
End If
With Me
.LstDossiers.Clear
[A1] = Left(Chemin, I)
If DosParent <> "" Then
.LstDossiers.AddItem DosParent
SousDossiers [A1]
Else
Dossiers [A1]
End If
ChargerFichiers [A1]
If Len([A1]) <> 3 Then
.LstDossiers.ListIndex = 0
End If
End With
End Sub
Hervé.
"Yves-Marie BIERSOHN" <yves-marie.biersohn@adm-ulp.u-strasbg.fr> a écrit
dans le message news: uPwFM5XiDHA.616@TK2MSFTNGP11.phx.gbl...
Bonjour,
Je souhaiterais obtenir dans une feuille excel, un menu déroulant avec
la
liste des disque dur, dans une autre liste, l'arborescence des fichiers
dépendant du premier menu déroulant, et un bouton validation pour
obtenir
a
partir de la ligne "5" et en colonne "A" la liste de tous les fichiers
du
dossier préselectionner.
Ensuite, je souhaite en colonne B, mettre une formule que je maitrise :)
et
ensuite, une autre macro, pour renommer tous les fichier avec la valeur
de
la colonne B.
Voila,
Merci beaucoup.
Salut Yves-Marie,
Voila ce que je t'ai bidouillé :
Mets sur ta feuille un ComboBox que tu nomme "CmbLecteurs", une ListeBox
que
tu nomme "LstDossiers" ensuite mets tout le code dans le module de la
feuille. Pour le test j'ai mis le remplissage du Combo pour les lecteurs
sur
Activate de la feuille donc change de feuille et revient ton Combo sera
plein. Un clic sur un dossier dans la liste t'inscris à partir de A5 les
fichiers Excel du dossier. Un double clic ouvre le dossier et affiche les
sous-dossiers avec un décalage un double-clic sur le dossier parent
remonte
dans arborescence. Je n'ai plus le temps de chercher pour le moment
comment
renommer tous les classeurs sans les ouvrir. Je verrai demain. Pour le
moment, teste et dis moi si cela te convient. Attention, j'utilise la
cellule [A1] pour afficher le chemin complet du dossier ouvert Adapte si
cela te dérange. Fait le test sur un classeur vierge.
Private Declare Function LesLecteurs Lib _
"kernel32" Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
'à mettre dans ThisWorkbook.Open
'pour avoir tous les lecteurs
'à l'ouverture du classeur
'l'appel :
'>Private Sub Workbook_Open()
'>Feuil1.Lecteurs
'>End Sub
'Je l'ai mis ici pour les tests
Private Sub Worksheet_Activate()
Lecteurs
End Sub
Private Sub CmbLecteurs_Click()
With Me
.LstDossiers.Clear
CheminComplet .CmbLecteurs.Value, False
Dossiers [A1]
ChargerFichiers .CmbLecteurs.Value
End With
End Sub
Private Sub LstDossiers_Click()
Dim I As Integer
Dim Chemin As String
Dim NomDossier As String
Range("A5:A" & Range("A5").End(xlDown).Row).Clear
With Me
Chemin = [A1]
With .LstDossiers
'si le dossier est un sous dossier (5 espaces à gauche)
'rajoute au chemin le nom du dossier sélectionné
If Left(.Value, 5) = Space(5) Then
Chemin = Chemin & Trim(.Value) & ""
Else
'si le chemin indique seulement le lecteur, rajoute
'le dossier sélectionné
If Len(Chemin) = 3 Then
Chemin = Chemin & .Value & ""
End If
End If
End With
End With
ChargerFichiers Chemin
End Sub
Private Sub LstDossiers_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim DosParent As String
On Error Resume Next
With Me.LstDossiers
If .ListIndex = 0 Then
If Err = 0 Then
DossierParent
Exit Sub
End If
End If
End With
On Error GoTo 0
'récupère le dossier parent, le recharge après avoir
'vidé la ListBox. Défini le chemin et appelle la
'proc SousDossiers pour charger les sousdossiers
'et les mettre en décalés
With Me.LstDossiers
DosParent = Trim(.Value)
.Clear
.AddItem DosParent
CheminComplet DosParent, True
SousDossiers [A1], DosParent
End With
Range("A5:A" & Range("A5").End(xlDown).Row).Clear
'charge les fichiers du dossier parent
ChargerFichiers [A1]
End Sub
Public Sub Lecteurs()
Dim LstLecteur As String
Dim Retour As Long
Dim I As Integer
Const LecteurDef As String = "C:" 'lecteur par défaut
'récup de la liste des lecteurs
LstLecteur = String(50, Chr$(0))
Retour = LesLecteurs(50, LstLecteur)
CmbLecteurs.Clear
For I = 1 To Len(LstLecteur)
If Mid(LstLecteur, I, 1) = "" Then
CmbLecteurs.AddItem UCase(Mid(LstLecteur, I - 2, 3))
End If
Next I
[A1] = LecteurDef
CmbLecteurs.Value = LecteurDef
End Sub
Private Sub Dossiers(Chemin As String)
Dim Dossier As String
Dim Tbl()
Dim I As Integer
'évite l'erreur du lecteur CD vide
'et plus bas, le tableau non initialisé
'dû à une disquette ou CD vierge
On Error Resume Next
Dossier = Dir(Chemin, 16)
If Err.Number <> 0 Then Exit Sub
Do While Dossier <> ""
If Dossier <> "." And Dossier <> ".." Then
If (GetAttr(Chemin & Dossier) _
And 16) = 16 Then
I = I + 1
ReDim Preserve Tbl(1 To I)
Tbl(I) = Dossier
End If
End If
Dossier = Dir
Loop
TriTableau Tbl()
'charge la listbox
Me.LstDossiers.List = Tbl()
Erase Tbl
End Sub
Sub TriTableau(Tbl())
Dim Tempo
Dim I As Integer
Dim J As Integer
'éffectue un tri
'croissant du tableau
For I = 1 To UBound(Tbl) - 1
For J = I + 1 To UBound(Tbl)
If Trim(Tbl(I)) > Trim(Tbl(J)) Then
Tempo = Tbl(J)
Tbl(J) = Tbl(I)
Tbl(I) = Tempo
End If
Next J
Next I
End Sub
Private Sub SousDossiers(Chemin As String, _
Optional DosParent As String)
Dim Tbl()
Dim Dossier As String
Dim I As Integer
'récupère les dossiers pour le chemin spécifié
'insére pour chaque sous-dossier 5 espaces avant
'afin de les démarquer du dossier parent en les
'décalant vers la droite
Dossier = Dir(Chemin, 16)
Do While Dossier <> ""
If Dossier <> "." And Dossier <> ".." Then
If (GetAttr(Chemin & Dossier) _
And 16) = 16 Then
I = I + 1
ReDim Preserve Tbl(1 To I)
Tbl(I) = Space(5) & Dossier
'Me.LstDossiers.AddItem Space(5) & Dossier
End If
End If
Dossier = Dir
Loop
On Error Resume Next
TriTableau Tbl()
'charge la listbox
For I = 1 To UBound(Tbl)
Me.LstDossiers.AddItem Tbl(I)
Next
Erase Tbl
End Sub
Sub ChargerFichiers(Chemin As String)
Dim Fichier As String
Dim FS As FileSearch
Dim I As Integer
Dim J As Integer
'vide les cellules
Range("A5:A" & Range("A5").End(xlDown).Row).Clear
'effectue la recherche
With Me
Set FS = Application.FileSearch
With FS
.LookIn = Chemin
.Filename = "*.xls" 'seulement Excel
If .Execute > 0 Then
J = 5
For I = 1 To .FoundFiles.Count
Range("A" & J) = Dir(.FoundFiles(I))
J = J + 1
Next I
End If
End With
End With
Set FS = Nothing
End Sub
Private Sub CheminComplet(Dossier As String, SousDossier As Boolean)
Dim I As Integer
Dim Chemin As String
Dim DosCourrant As String
Dim Lecteur As Boolean
'cherche si le dossier est le lecteur
'si il l'est, attribut la valeur de la variable
'Dossier à la variable Chemin, sinon, défini
'le chemin
Lecteur = Dossier Like "?:"
If Lecteur = False Then
Chemin = [A1]
'recherche le nom du dossier ouvert
For I = Len(Chemin) - 1 To 3 Step -1
If Mid(Chemin, I, 1) = "" Then
DosCourrant = Mid(Chemin, I + 1, Len(Chemin) - (I + 1))
Exit For
End If
Next I
If I < 3 Then I = 3
'si le dossier est différent, éffectue le changement
'ou le rajoute en fonction de la valeur de la variable
'SousDossier
If Dossier <> DosCourrant Then
If SousDossier = False Then
Chemin = Left(Chemin, I) & Dossier & ""
Else
Chemin = Chemin & Dossier & ""
End If
Else
Chemin = Chemin
End If
Else
Chemin = Dossier
End If
'défini la cellule qui sert pour la recherche
'et l'information sur le dossier ouvert
[A1] = Chemin
End Sub
Private Sub DossierParent()
Dim I As Integer
Dim J As Integer
Dim Chemin As String
Dim DosParent As String
Chemin = [A1]
'si le chemin ne contient pas que le lecteur
'recherche la barre de séparation
If Len(Chemin) > 3 Then
For I = Len(Chemin) - 1 To 3 Step -1
If Mid(Chemin, I, 1) = "" Then
Exit For
End If
Next I
'recherche le dossier parent
For J = I - 1 To 3 Step -1
If Mid(Chemin, J, 1) = "" Then
DosParent = Mid(Chemin, J + 1, (I - 1) - J)
Exit For
End If
Next J
Else
'défini I à 3 pour le lecteur
I = 3
End If
With Me
.LstDossiers.Clear
[A1] = Left(Chemin, I)
If DosParent <> "" Then
.LstDossiers.AddItem DosParent
SousDossiers [A1]
Else
Dossiers [A1]
End If
ChargerFichiers [A1]
If Len([A1]) <> 3 Then
.LstDossiers.ListIndex = 0
End If
End With
End Sub
Hervé.
"Yves-Marie BIERSOHN" a écrit
dans le message news:Bonjour,
Je souhaiterais obtenir dans une feuille excel, un menu déroulant avec
la
liste des disque dur, dans une autre liste, l'arborescence des fichiers
dépendant du premier menu déroulant, et un bouton validation pour
obtenir
apartir de la ligne "5" et en colonne "A" la liste de tous les fichiers
du
dossier préselectionner.
Ensuite, je souhaite en colonne B, mettre une formule que je maitrise :)
etensuite, une autre macro, pour renommer tous les fichier avec la valeur
de
la colonne B.
Voila,
Merci beaucoup.
