Explorer et liste fichier dans Excel [Résolu]

Signaler
Messages postés
56
Date d'inscription
samedi 24 mai 2008
Statut
Membre
Dernière intervention
6 novembre 2010
-
Messages postés
56
Date d'inscription
samedi 24 mai 2008
Statut
Membre
Dernière intervention
6 novembre 2010
-
Bonjour,

J'ai copié 2 macro (récupérée et adaptée) dans un module de mon projet VBA qui permet :

- explorer pour sélectionner un dossier
- copier les noms des fichiers dans une colonne d'une feuille Excel

j'ai créer 2 boutons sur ma feuille Excel auxquels j'ai associé les 2 macros. Cela fonctionne.

Cependant, j'ai pour objectif de ne passer que par les formulaires.

J'ai essayé de créer des boutons dans mon formulaire afin de lancer ces deux macros, mais cela ne fionctionne pas.

Comment puis-je faire ?

D'avance merci.

Cordialement
Hidozo

7 réponses

Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
il te sert à quoi ce code ??

tu as déjà inséré le userform au moins ?
je pars du principe que oui. Donc place un CommandButton dessus, double click dessus, et l'évènement TonBouton_Click() apparait.

Beh c'est là dedans qu'il faut placer tes call
d'après ce que j'ai vu, tu fais un Call appel et un fenêtre doit apparaitre pour choisir une directory.
Cette valeur se place dans la cellule X1.
Ensuite tu fais un Call RecupFichierTableau et ça va chercher des données
Au passage, le paramètre Chemin dans la Sub RecupNomFichier est inutilse, puisque dans cette procédure, Chemin est égale à la cellule X1

@++

le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
allez, je suis brave, je t'ai 3 ou 4 commentaires :

'Option Explicit

Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Function GetDirectory(Optional Msg) As String
' bInfo est déclaré en
tant que BrowseInfo, donc après, pour l'utiliser _
c'est bInfo. et après le point
les variables déclarées dans le type apparaissent
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
' attribution d'une valeur nulle
bInfo.pidlRoot = 0&
' si msg (en paramètre) ne contient rien, on affiche ce
titre
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1

' on appelle
l'explorateur de dossier, avec en param les infos de bInfo, et _
on enregistre le retour ID dans
x
x = SHBrowseForFolder(bInfo)
path = Space$(512)

'la on récupère le chemin
sélectionné
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)

' on place le chemin dans la
cellule X1
Range("x1") = GetDirectory
Else
GetDirectory = ""
End If
End Function

'Appel a la
procedure :
Sub appel()

' Efface les données de
la plage de données
Range("z1:z10000").ClearContents
Msg = "Selection de la directory desire"
'change le répertoire courant en récupérant l'info dans la
fonction GetDirectory, donc là rdv à GetDirectory
ChDir GetDirectory(Msg)
End Sub

Sub RecupNomFichier(ByVal Chemin As String, ByRef Tableau As Variant)
Dim Fichier As String
Dim Compteur As Integer
Dim LigneCompteur As Integer

' récupère le chemin
depuis X1
Chemin = Range("x1")
Chemin = Chemin + "\*.*"
Compteur = 1
' récupère le nom du premier
fichier contenu dedans
Fichier = Dir(Chemin)
Do While (Len(Fichier) > 0)
'  a l'aide d'une boucle tous les noms de fichiers contenus dans le
répertoire _
 sont
placés dans la colonne Z
ReDim Preserve Tableau(Compteur)
Tableau(Compteur - 1) = Fichier
LigneCompteur = Compteur + 1
ActiveSheet.Range("z" & LigneCompteur).Value = Tableau(Compteur - 1)
Compteur = Compteur + 1
Fichier = Dir()
Loop
End Sub

Sub RecupFichierTableau()
Application.ScreenUpdating = False
On Error Resume Next
Dim Tableau() As String
Call RecupNomFichier(Chemin, Tableau)
FiltreAlpha
End Sub
~
<small>[code.aspx?ID=39466 Mortalino] ~
Colorisation automatique</small>

@++

le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
salut,

dans l'évènement Click de tes CommanbButton :

Call NomDeLaSub

@++

le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
Messages postés
56
Date d'inscription
samedi 24 mai 2008
Statut
Membre
Dernière intervention
6 novembre 2010

Je vais essayer de ce pas
Messages postés
56
Date d'inscription
samedi 24 mai 2008
Statut
Membre
Dernière intervention
6 novembre 2010

J'ai ceci comme code dans mon module :

ce qui est en rouge est la définition des paramètre. Où dois-je mettre le call ?

la partie en vert je la garde même si je ne l'utilise pas, car sinon la macro récup fichier ne marche pas

Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)


Range("x1") = GetDirectory
Else
GetDirectory = ""
End If
End Function


'Appel a la procedure :
Sub appel()


Range("z1:z10000").ClearContents
Msg = "Selection de la directory desire"
ChDir GetDirectory(Msg)
End Sub
Sub RecupNomFichier(ByVal Chemin As String, ByRef Tableau As Variant)
Dim Fichier As String
Dim Compteur As Integer
Dim LigneCompteur As Integer
Chemin = Range("x1")
Chemin = Chemin + "\*.*"
Compteur = 1
Fichier = Dir(Chemin)
Do While (Len(Fichier) > 0)
ReDim Preserve Tableau(Compteur)
Tableau(Compteur - 1) = Fichier
LigneCompteur = Compteur + 1
ActiveSheet.Range("z" & LigneCompteur).Value = Tableau(Compteur - 1)
Compteur = Compteur + 1
Fichier = Dir()
Loop
End Sub




Sub RecupFichierTableau()
Application.ScreenUpdating = False
On Error Resume Next
Dim Tableau() As String
Call RecupNomFichier(Chemin, Tableau)
FiltreAlpha
End Sub



Sub Imprim()
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End Sub
Sub FiltreAlpha()
Columns("z:z").Select
Selection.Sort Key1:=Range("x2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
With Selection
.HorizontalAlignment = xlGeneral
.Orientation = 0
End With
With Selection
.HorizontalAlignment = xlRight
.Orientation = 0
End With
Range("D1").Select
End Sub


d'avance merci
Messages postés
56
Date d'inscription
samedi 24 mai 2008
Statut
Membre
Dernière intervention
6 novembre 2010

Ca marche,

Merci beaucoup

J'essaye d'apprendre en faisant des copier coller de code et en essayant de comprendre l'écriture, ce n'est pas la méthode idéale, mais bon, je ne me vois pas comment faire d'autre

A plus

Merci
Messages postés
56
Date d'inscription
samedi 24 mai 2008
Statut
Membre
Dernière intervention
6 novembre 2010

Que dire : Milles merci pour ces bonnes explications !!!

Par contre, j'ai gardé en plsu (même si je ne m'en sert pas la parti Imprim, car siinon, ça me donne une erreur lié au flitre alpha.

Par contre ma procédure fonctionne à merveille. Cependant, de temps en temps la liste box que j'ai associé à la liste des fichiers iddue de la récap tableau ne fonctionne pas et ne me donne le choix qu'avec le 1er fichier.

En tout merci beaucoup

Hidozo