Bonjour à tous ! Je vous présente rapidement mon cas : je suis seconde année de DUT informatique. Pour valider mon diplôme, je termine l'année par un stage. On me demande de reprendre un programme VBA pour Excel. La 1ère version était codée pour Excel 2002 et 2003, et je dois l'adapter pour 2007.
Jusqu'à maintenant, je n'ai rencontré aucun souci de compatibilité et tout marche correctement. Sauf que voilà, il fallait que ça arrive, j'ai (enfin ?) une erreur entre les versions : la fonction FileSearch des anciennes versions ne fonctionne plus sur 2007.
J'ai cherché sur internet des solutions, et j'ai trouvé ceci :
La solution me parait bien compliquée par rapport au code de mon employeur...qui elle, tient en 3 lignes :File Search ne fonctionne plus sous excel 2007. Voici une solution de contournement pour récupérer la liste des fichiers contenus dans un dossier
pour utiliser cette fonction depuis une macro, en utilisant l'adresse du répertoire située en A1 et pour restituer la liste des fichiers dans en E1, E2 ...
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33 Public Function getDir(path As String, sortie As String) As Variant Dim fList() As String Dim iPosition As Long Dim iSize As Long Dim sFile As String Dim fRange As Excel.Range Const iIncrement As Long = 50 iSize = iIncrement ReDim fList(1 To iSize) 'vous pouvez indiquer *.* pour obtenir la liste de tous les fichiers ou filtrer par l'extension sFile = Dir(path & IIf(Right(path, 1) = "", "", "") & "*.xls") Do While Len(sFile) iPosition = iPosition + 1 If iPosition > iSize Then iSize = iSize + iIncrement ReDim Preserve fList(1 To iSize) End If fList(iPosition) = sFile sFile = Dir Loop If iSize > iPosition Then ReDim Preserve fList(1 To iPosition) End If Set fRange = Range(sortie).Resize(iPosition, 1) fRange.Value = WorksheetFunction.Transpose(fList) fRange.Sort key1:=fRange.Cells(1), order1:=xlAscending getDir = fRange.Value End Function
Si tu as besoin en plus de lister les sous répertoires utilise plutôt cette macro :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4 Public Sub FileSearch2007() Dim v As Variant v = getDir(Feuil1.Cells(1, 1), "E1") end sub
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20 Public Ligne As Long Sub RechercheFichiers() Ligne = 0 racine = "e:\donnees\daniel\mpfe" 'Mets ici ton dossier pricipal Set fso = CreateObject("Scripting.FileSystemObject") Set dossier_racine = fso.getfolder(racine) Lit_dossier dossier_racine End Sub Sub Lit_dossier(ByRef dossier) For Each d In dossier.SubFolders Lit_dossier d Next For Each f In dossier.Files Ligne = Ligne + 1 ActiveSheet.Hyperlinks.Add Cells(Ligne, 1), f.Path, TextToDisplay:=f.Name 'Cells(Ligne, 1) = f.Path Next End Sub
A la place du "etc", on a la suite du "remplissage" de la table, donc rien ne change ici selon les versions, c'est pas le problème.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22 Set fs = Application.FileSearch With fs .MatchTextExactly = True .Filename = nomcherche If .Execute > 0 Then MsgBox "Ce nom existe déjà " & .FoundFiles.Count & _ " fiche(s) trouvée." For i = 1 To .FoundFiles.Count ' MsgBox .FoundFiles(i) Next i Else ' MsgBox "Création " & nomcherche ' on crée maintenant la fiche technique chemin_ftm = chemindonnees + "0FICHE TECHNIQUE MODELE.xls" Workbooks.Open Filename:=chemin_ftm Range("F2").Select ActiveCell = nomfiche Range("f5").Select Etc...
Je n'arrive pas trop à voir la ressemblance entre la solution trouvée sur le net et le code de mon employeur. Je voudrais donc savoir s'il existe une fonction de recherche toute bête dans Excel 2007 pour éviter d'avoir à créer cinquante mille fonctions supplémentaires. Je souhaiterais une fonction qui fait une simple recherche par nom de fichier dans un seul et même dossier (toutes les fiches techniques sont sauvegardées dans le même dossier, il n'y a pas de sous dossier, d'autre dossier, etc...).
Je vous remercie d'avance pour vos solutions.
Partager