Userform et ouverture de Répertoire

[Thebeginner]

Bonjour tout le monde,

J'ai un petit soucis de gestion de la position d'un userform et de l'ouverture et fermeture d'un userform.

Mon code permet de vérifier qu'il y a un seul fichier .xls dans un répertoire, s'il y a plus d'un fichier .xls le répertoire s'ouvre, l'utilisateur doit supprimer les fichiers superflus, puis fermer fermer le répertoire et cliquer sur ok (dans le userform)

Mes problèmes:

• Ouvrir le répertoire dans la taille maximale (plein écran)
• Que le userform apparaisse devant le répertoire ouvert
• Vérifier que le répertoire a bien été fermé par l'utilisateur, sinon le fermer

En espérant avoir été plus clair que lors mon dernier message, je vous remercie de votre attention.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
retour1:
 
          Fichier = Dir(chemin2 & "*.xls*")
          compteur = 0
            Do While Len(Fichier) > 0
                If compteur = 1 Then ' Cela signifie qu'il y a plus 'un fichier .xls
                    Set objShell = New Shell
                    objShell.Explore (chemin2) 'ouvre le répertoire dont le chemin d'accès est chemin2
 
                    TROP.Show 'Doit apparaitre devant le répertoire
 
                    GoTo retour1 'recommence la boucle pour vérifier que les fichiers superflux ont été supprimés
                End If
 
                Range("i" & (laligne)) = Fichier ' inscrit le nom du fichier dans une cellule du classeur
                Fichier = Dir()
                compteur = 1
            Loop

[Daniel.C]

Bonjour,

Tu vas au devant de grandes difficultés dans cette direction. Pourquoi ne pas utiliser un contrôle TreeView ou ListView, voire une ListBox sur lesquels tu as toute la maîtrise voulue ?

[Thebeginner]

Bonjour Daniel et merci pour ton complément d'information,

Etant débutant en VBA, je ne connais pas les solutions que tu proposes...

Dans ce que je cherche à faire, l'utilisateur devrait pouvoir ouvrir les fichiers pour vérifier lesquels il doit supprimer, puis la macro devrait prendre le relais...

Est-ce possible avec l'une de tes propostions?

Je vais découvrir treeview, listview et listbox, voir un peu comment cela fonctionne.

Un grand merci à toi.

[ZebreLoup]

Je suis d'accord avec Daniel, si tu es débutant en VBA, ne te lance pas dans l'utilisation des API Windows qui sont sans doute la seule solution à ce que tu veux faire exactement.

Maintenant, même si c'est plus simple, l'utilisation de ListView ou autre risque d'être tout de même assez laborieuse pour un débutant en VBA, surtout si tu veux que l'utilisateur puisse vérifier le contenu des fichiers avant de les effacer.

Pourquoi ne pas tout simplement laisser comme tu as fait en bloquant la macro tant qu'il n'y a pas un seul fichier. En gros laisser tomber le dernier point de ta demande. Est-ce vraiment grave si le répertoire reste ouvert pour l'utilisateur ?

[Thebeginner]

Salut ZebreLoup,

Merci pour ton intervention.

Non ce ne serait pas une catastrophe si le répertoire reste ouvert... Par contre je viens de constaté qu'il est impossible d'ouvrir un fichier .xls de ce répertoire puisque la macro est en mode pause.

Je pourrais résoudre ce problème en ajoutant un bouton dans le Userform "Annuler et vérifier manuellement le contenu des fichiers). Tout à fait envisageable.

Par contre, le userform reste derrière le répertoire ouvert, si bien que l'utilisateur a d'un coup un répertoire ouvert mais ne sait pas ce qu'il doit faire. Je ne sais pas comment faire pour que le userform soit devant le répertoire....

As-tu une solution?

Merci.

(Je suis entrain de regarder pour les listview, pas évident...)

[ZebreLoup]

Tu dois effectivement pouvoir trouver un solution pour arrêter la macro et renseigner une propriété du UserForm pour que ton programme contenant cette vérification reprenne à cette étape seulement.
Par exemple tu sépares ton code en 2 et lors de la vérification, s'il y a plus d'un fichier, tu ouvres le répertoire, tu mets un paramètre multiFileCheck que tu as créé à False. Et lors du prochain lancement (enfin de chaque lancement) soit tu enchaines les deux procédures, soit seulement la deuxième en fonction de ce paramètre.

Pour ce qui est de la position du UserForm, tu peux aussi faire apparaitre une MsgBox qui explique ce qu'il faut faire avant l'affichage du répertoire.

[Thebeginner]

Hello,

En effet, le msgbox avant l'affichage du répertoire permettra à l'utilisateur de savoir ce qu'il faut faire.... Ensuite le code peut reprendre au même endroit, ce n'est pas un soucis. (il refait le test)

Cela me semble être la bonne solution, en tous cas en attendant la maitrise des listview.

à ce sujet, j'ai récupéré le code ci-dessous, mais j'ai une erreur pour FindExecutable

Faut-il que j'ajoute une référence? Si oui laquelle?

Un grand merci pour ta solution du msgbox avant l'affichage.

Code :

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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
'--------- Procédure à placer dans le module objet du UserForm ----------------
 
'Ajoutez:
'Un Label (LaBel1)
'Une ImageList (ImageList1)
'Une ListView (ListView1)
'Un commandButton (CommandButton1)
'
'Adaptez le répertoire cible
'
Option Explicit
 
 
Private Sub UserForm_Initialize()
 
    'Définit les entêtes de colonnes
    With ListView1
        With .ColumnHeaders
            .Clear 'Supprime les anciens entêtes
 
            'Ajout des colonnes
            .Add , , "Nom fichier", 200
            .Add , , "Taille", 40, lvwColumnRight
            .Add , , "Créé le", 60, lvwColumnCenter
            .Add , , "Modifié le", 60, lvwColumnCenter
            .Add , , "Commentaires", 200, lvwColumnLeft
        End With
 
    .View = lvwReport 'affichage en mode Rapport
    .Gridlines = True 'affichage d'un quadrillage
    .FullRowSelect = True 'Sélection des lignes comlètes
    End With
End Sub
 
 
Private Sub CommandButton1_Click()
 
    'Adaptez le répertoire cible
    ElementsRepertoire "C:\Documents and Settings\michel\Repertoire"
End Sub
 
 
Private Sub ElementsRepertoire(Chemin As String)
    Dim objShell As Object, strFileName As Object
    Dim objFolder As Object
    Dim i As Integer
    Dim Executable As String
 
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.NameSpace(CStr(Chemin))
 
    Label1 = Chemin
    'Suppression des ancien éléments
    ListView1.ListItems.Clear
 
    'Supprime les anciens îcones et définit la taille d'affichage
    With ImageList1
        .ListImages.Clear
        .ImageWidth = 16
        .ImageHeight = 16
    End With
 
    'Boucle sur les fichiers du dossier cible
    '******************************
    For Each strFileName In objFolder.Items
        'Vérifie s'il s'agit d'un sous dossier (non pris en compte)
        If strFileName.IsFolder = False Then
            i = i + 1
            'Recherche l'executable associé pour ouvrir les fichiers
            Executable = FindExecutable(Chemin & "\" & objFolder.GetDetailsOf(strFileName, 0))
 
            'Récupère le 1er icone de l'executable dans l'ImageList
            ImageList1.ListImages.Add , "cle" & i, GetIconFromFile(Executable, 0, False)
            'Associe la l'ImageList à la ListView
            ListView1.SmallIcons = ImageList1
 
                With ListView1
                    'Ajoute une ligne
                    .ListItems.Add , , objFolder.GetDetailsOf(strFileName, 0)
 
                    'Stocke le chemin complet qui servira à ouvrir le fichier
                    .ListItems(i).Tag = Chemin & "\" & strFileName
 
                    '---------------
                    'Pour plus de détails sur la méthode utilisée pour récupérer les propriétés des fichiers:
                    'http://silkyroad.developpez.com/VBA/ProprietesClasseurs/#LIV-C
                    '---------------
 
                    'Ajoute une infobulle contenant le type de fichier et le nom de l'auteur
                    .ListItems(i).TooltipText = "Type: " & objFolder.GetDetailsOf(strFileName, 2) & _
                    "  ,  Auteur: " & objFolder.GetDetailsOf(strFileName, 9)
 
                    'Ajoute les sous éléments (Taille, Créée le, Modifié le, Commentaires)
                    .ListItems(i).ListSubItems.Add , , _
                                objFolder.GetDetailsOf(strFileName, 1)
                    .ListItems(i).ListSubItems.Add , , _
                            Format(objFolder.GetDetailsOf(strFileName, 4), "DD/MM/YYYY")
                    .ListItems(i).ListSubItems.Add , , _
                            Format(objFolder.GetDetailsOf(strFileName, 3), "DD/MM/YYYY")
                    .ListItems(i).ListSubItems.Add , , _
                                    objFolder.GetDetailsOf(strFileName, 14)
 
                    'Associe l'îcone au type de fichier
                    .ListItems(i).SmallIcon = "cle" & i
                End With
        End If
 
    Next strFileName
End Sub
 
 
'Ouvre le fichier par un double clic sur la ligne
Private Sub ListView1_DblClick()
    Dim leFichier As String
 
    'Le chemin complet est stocké dans le Tag
    leFichier = ListView1.ListItems.Item(ListView1.SelectedItem.Index).Tag
    Unload Me
 
    If Right(leFichier, 4) = ".xls" Then
        ThisWorkbook.FollowHyperlink leFichier
        Else
        ShellExecute 0, "open", leFichier, "", "", vbNormalFocus
    End If
End Sub

[ZebreLoup]

Tu n'as pas du récupérer tout le code nécessaire. Tu auras le même problème avec GetIconFromFile. Ca doit être une fonction issue de l'API windows dont on parlait au dessus.
Un exemple trouvé sur Google :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Declare Function FindExecutable Lib "shell32.dll" _
        Alias "FindExecutableA" (ByVal lpFile As String, _
        ByVal lpDirectory As String, ByVal lpResult As String) As Long
 
Private Function FichierAssocie(stFichier As String, stChemin As String) As String
' Retour l'application associé au fichier passé en argument.
Dim stRep As String
Dim lgRep As Long
' Initialisation du buffer de retour
stRep = Space$(250)
' Appel à la fonction
lgRep = FindExecutable(stFichier, stChemin, stRep)
' Traitement de la valeur de retour
stRep = Left$(stRep, InStr(1, stRep, vbNullChar) - 1)
' Retourne le résultat
FichierAssocie = stRep
End Function

[Daniel.C]

Je suis entrain de regarder pour les listview, pas évident...

Courage, tu as un bon tuto ici :

http://silkyroad.developpez.com/VBA/ListView/

[Daniel.C]

Un exemple avec un userform (UserForm1), une ListView (ListView1) et un command button (CommandButton1). Note que les fichiers supprimés ne vont pas dans la corbeille, mais sont effacés définitivement. Une alternative est de les mettre dans un dossier dépotoir. Le code est à mettre ddans le module de l'userform :

Code :

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
Private Sub UserForm_Initialize()
 
    Dim Chemin As String, FSO As Object, Dossier As Object, F As Object
    Chemin = "C:\Users\Daniel\Documents\Donnees\Daniel\mpfe"
    'Définit les entêtes de colonnes
    With ListView1
        With .ColumnHeaders
            .Clear 'Supprime les anciens entêtes
 
            'Ajout des colonnes
            .Add , , "Nom fichier", 200
            .Add , , "Taille", 40, lvwColumnRight
            .Add , , "Créé le", 60, lvwColumnCenter
            .Add , , "Modifié le", 60, lvwColumnCenter
            .Add , , "Commentaires", 200, lvwColumnLeft
        End With
 
    .View = lvwReport 'affichage en mode Rapport
    .Gridlines = True 'affichage d'un quadrillage
    .FullRowSelect = True 'Sélection des lignes comlètes
    .CheckBoxes = True
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Dossier = FSO.getfolder(Chemin)
    For Each F In Dossier.Files
        If InStr(F.Name, ".xls") > 0 Then
            ctr = ctr + 1
            .ListItems.Add , , F.Name
            .ListItems(ctr).ListSubItems.Add , , F.Size
            .ListItems(ctr).ListSubItems.Add , , F.datecreated
            .ListItems(ctr).ListSubItems.Add , , F.datelastmodified
        End If
    Next F
    End With
End Sub
 
Private Sub CommandButton1_Click()
    Dim Rep
    With Me.ListView1
        'Boucle ppour trouver les fichiers cochés
        For i = 1 To Me.ListView1.ListItems.Count
            If .ListItems(i).Checked = True Then
                Rep = MsgBox("Voulez-vous supprimer définitivement le fichier : " & _
                    .ListItems(i).Text & " ?", vbOKCancel)
            'Supprime DEFINITIVEMENT le fichier
            If Rep = vbOK Then Kill Chemin & "\" & .ListItems(i).Text
            End If
        Next i
    End With
End Sub

Note. Je n'ai pas trouvé la zone commentaires des fichiers. Pose la question dans un nouveau fil si tu y tiens.