explorer et liste fichier dans ExcelRésolu

Question

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

mortalino · Accepted Answer

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

mortalino · Answer

salut,

dans l'évènement Click de tes CommanbButton :

Call NomDeLaSub

@++

le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA

hidozo · Answer

Je vais essayer de ce pas

hidozo · Answer

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

hidozo · Answer

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

mortalino · Answer

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 ~ [code.aspx?ID=39466 Mortalino] ~ Colorisation automatique @++ le mystérieux chevalier,"Provençal, le gaulois" Forum Office & VBA

hidozo · Answer

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

Explorer et liste fichier dans Excel

7 réponses

Votre réponse

Discussions similaires