Discussion :

[arnaudTHE]

Bonjour à tous,

Tout d'abord je souhaite remercier SilkyRoad pour son superbe tutoriel "Un complément FileSearch pour Excel 2007".
Il est installé et fonctionne sur mon fichier.

En revanche, je cherche à un peu le "customiser".
Voilà mes deux points :
1- Comment placer la fenêtre de sélection du dossier à analyser au milieu de l'écran. En effet, il se place par défaut en haut à gauche. Je n'arrive pas coder un placement automatique vers le centre de l'écran.
2- Est-il possible de présélectionner un dossier par défaut dans la fenêtre de recherche ? Je m'explique, les utilisateurs utiliseront souvent la même arborescence, or c'est un peu fastidieux pour l'utilisateur de refaire à chaque fois le chemin.

Si je n'ai pas été clair, je peux donner un peu plus d'indications!

Dans l'espoir d'obtenir quelques conseils,
Bonne semaine à tous.

Pour information j'ai utilisé le code de Silkyroad :
http://silkyroad.developpez.com/vba/classefilesearch/

[casefayere]

Bonjour,

J'ai retrouvé ces deux exemples dans mes archives, (à adapter)

1er exemple (code avec classefilesearch) :

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
34
35
Sub fichiers_recherches()
Dim i As Long, stmessage As String, nom As String, nom2 As String, inombre As Integer
Dim recherche As ClFileSearch.ClasseFileSearch, r As String, partienom As String
'ci-dessous, on donne à "r" le chemin de la recherche
r = InputBox("Les sous-dossier sont inclus dans la Recherche", "dossier de recherche", ThisWorkbook.Path) 'exemple
If r = "" Then Exit Sub
partienom = InputBox("contenu du fichier à rechercher", "RECHERCHE DE FICHIER", ".xlsm")
If partienom = "" Then Exit Sub
Set recherche = ClFileSearch.Nouvelle_Recherche
With recherche
   'répertoire pour lancer la recherche
   .FolderPath = r
   'inclu les sous-dossiers dans la recherche
   .SubFolders = True
   'Option de tri:
   '(Sort_None, sort_Name, sort_Path, sort_Size, sort_DateCreated, sort_LastModified, sort_Type)
   'Pas de tri si le paramètre n'est pas spécifié.
   .SortBy = sort_DateCreated
   .Extension = "*" & partienom & "*"
   'procède à la recherche et capture le nombre de fichiers trouvés
   inombre = .Execute
   If inombre = 0 Then
      MsgBox "0" & " fichier trouvé"
      Exit Sub
   End If
      stmessage = VBA.Format(inombre, "0"" fichiers trouvés""")
      For i = 1 To .FoundFilesCount
         nom = .Files(i).strfileName 'nom fichier
         nom2 = .Files(i).strpathName & "\" & nom
         Range("a" & i) = nom 'nom du fichier
         Range("b" & i) = nom2 'avec son chemin
      Next i
End With
 
End Sub

2ème exemple avec FSO (fichier) :

bon courage

[arnaudTHE]

Un grand merci à toi casefayere.
Néanmoins, je n'ai pas su trouver dans tes propositions un moyen d'entrer directement à l'ouverture de la fenêtre de sélection du dossier, une arborescence de base...
Ni de prépositionner la fenêtre au centre de la fenêtre.

Voici la fameuse fenêtre de sélection de dossier.


Pour résumer mes deux soucis :
- Comment faire pour lorsque cette fenêtre s'affiche, qu'une arborescence soit déjà faite? (je ne sais pas quoi écrire dans mon code ci-dessous...).
- Comment positionner cette fenêtre au centre de l'écran?

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
 
Option Explicit
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260
Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" _
(ByVal lpFile As String, ByVal lpDirectory As String, _
ByVal lpResult As String) As Long
 
Private Declare Function SHBrowseForFolder Lib _
"shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib _
"shell32" (ByVal pidList As Long, ByVal lpBuffer _
As String) As Long
Private Declare Function lstrcat Lib "kernel32" _
Alias "lstrcatA" (ByVal lpString1 As String, ByVal _
lpString2 As String) As Long
Private Type BrowseInfo
   hWndOwner As Long
   pIDLRoot As Long
   pszDisplayName As Long
   lpszTitle As Long
   ulFlags As Long
   lpfnCallback As Long
   lParam As Long
   iImage As Long
End Type
 
Sub RechercheFichiers()
'Declaration Variables
Dim lpIDList As Long
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
Dim sBuffer As String
Dim i As Long
Dim Recherche As ClFileSearch.ClasseFileSearch
szTitle = "Clic sur le repertoire voulu"
 
With tBrowseInfo
    .lpszTitle = lstrcat(szTitle, "")
    .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
 
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
   sBuffer = Space(MAX_PATH)
   SHGetPathFromIDList lpIDList, sBuffer
   sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
End If
 
Set Recherche = ClFileSearch.Nouvelle_Recherche
With Recherche
    'Définit le répertoire de recherche
    .FolderPath = sBuffer
    'Définit la recherche dans les sous dossiers (True / False)
    .SubFolders = True
    'Option de tri:
    '(Sort_None, sort_Name, sort_Path, sort_Size, sort_DateCreated, sort_LastModified, sort_Type)
    'Pas de tri si le paramètre n'est pas spécifié.
    .SortBy = sort_Path
    'Option pour rechercher un type de fichier
    '(Renvoie tous les fichiers si non spécifié)
    'Exemple : .Extension = "*.doc"
    'Execute la recherche
    .Execute
 
Set Recherche = Nothing
End Sub

Merci à tous ceux qui pourront m'aider!

[casefayere]

re,

Nous verrons ensuite le positionnement de la fenêtre, pour l'arborescence, je t'ai proposé, grace à une variable "r", un chemin d'origine, il suffit d'adapter, mais je n'ai peut-être pas compris !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

r = InputBox("Les sous-dossier sont inclus dans la Recherche", "dossier de recherche", ThisWorkbook.Path) 'exemple

"ThisWorkbook.Path" représentant le chemin du fichier actif

[arnaudTHE]

Merci casefayere, ta solution fonctionne en effet.

En fait ce que je cherchais c'est directement dans ma fenêtre de sélection, d'avoir une arborescence déjà proposée.
Voici un exemple :

[casefayere]

essayes ce code sur classeur vierge ;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub choix_dossier()
Dim objshell, objfolder, ofolderitem, chemin
    Set objshell = CreateObject("Shell.Application")
    Set objfolder = objshell.BrowseForFolder(&H0&, "Choisir un répertoire", &H210&, ThisWorkbook.Path)
    On Error Resume Next
    Set ofolderitem = objfolder.Items.Item
    chemin = ofolderitem.Path
 
    Range("A1").Value = chemin
End Sub

vu sur :
http://www.developpez.net/forums/d74...ix-repertoire/