Discussion :

[curt]

Bonsoir,

je cherche à ouvrir une sélection de fichier (du type .GetOpenFilename ou .FileDialog(msoFileDialogFolderPicker) mais en verrouillant l'accès au dossier.

En clair, l'utilisateur ne peut pas "se promener" dans l'arborescence et doit sélectionner un ou plusieurs fichiers dans le dossier qu'on lui propose.

Bon week-end sous le soleil.
Curt

[kiki29]

Salut, comme point de départ tu pourrais utiliser Liste des fichiers d'un dossier : Win 32/64 Bits, il y en a d'autres via cette liste

[patricktoulon]

bonsoir
je ne sais pas si on peu bloquer les sub menu des boite de dialogue fichier qui pourrait empecher l'utilisateur de naviguer
ouvrir la boite sur un dossier precis oui!!

3 versions la 3eme ne recuperant que le chemin mais n'ouvraont pas de fichier

Code :

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

1
2
3
4
Sub test1()
 ChDir "C:\Users\polux\Desktop\"
 Application.Dialogs(xlDialogOpen).Show
 End Sub

S

Code :

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

1
2
3
4
5
6
7
ub test2()
With Application.FileDialog(msoFileDialogOpen)
     .InitialFileName = "C:\Users\polux\Desktop\"
     .Show
     If .SelectedItems.Count > 0 Then Workbooks.Open .SelectedItems(1)
 End With
End Sub

Code :

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

1
2
3
4
5
6
Sub test3()
 ChDir "C:\Users\polux\Desktop\"
fileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If fileToOpen <> False Then
End If
End Sub

[curt]

Hello Kiki29,

j'ai déjà utilisé tes liens. Mais la sélection des fichiers se fait à travers une procédure.
Il ne s'agit pas d'afficher des fichiers, mais de permettre à l'utilisateur de sélectionner n fichiers dans LE DOSSIER qu'on lui permet de voir au travers de la popup.
(ou alors je n'ai peut être pas compris les liens)

Curt

[curt]

Salut Patrick,

c'est très exactement ce que je veux réaliser. Bloquer le choix du dossier.
Curt

[patricktoulon]

j'ai repondu avec l'exemple 3

mais pour empecher l'utilisateur de naviguer dans la boite de dialogue ca c'est moins sur en attendant ils s'ouvre sur le dossier du CHDIR

[kiki29]

Salut, une recherche ? A toi de voir.

[unparia]

Bonjour
Si l'on veut à la fois :
- empêcher l'utilisateur de sélectionner un fichier autre que parmi ceux d'un dossier imposé
- lui permettre la sélection de plusieurs fichiers
- l'empêcher d'agir (suppression, renommage, etc ...) sur les fichiers de ce dossier
je ne connais personnellement qu'une seule méthode sûre (mise à part l'utilisation d'un ocx pour imiter la filelistbox de VB6) --->>
Utilisation de la fonction Dir de VBA et abondement d'une listbox multiselect.

[curt]

Bonjour à tous,

et tout d'abord merci pour les différentes pistes.
J'en suis arrivé à la même conclusion que Unparia, il faut alimenter une ListBox...

La solution (à personnaliser) est là : https://www.developpez.net/forums/d1...tbox-userform/

Merci à Développez.com et à ses contributeurs

Curt

[patricktoulon]

re
ca ne devrais pas etre trop difficile dans un userform surtout si tu veux qu'un typoe de fichier
attention quand meme les sous dossiers de ce dossier
si les fichiers de ces sous dossiers doivent etre pris en compte il te faudra une fonction recursive


il y en a beaucoup de fichier ?
la selection devra etre multiple ou pas ?
si la reponse est non et non il y a peut etre un moyen de se passer de userform

[curt]

Salut Patrick,

que de conseils !! Merci

Le projet est le suivant :
J'extraie des attributs de blocs (statiques et dynamiques d'AutoCad) au moyen d'Excel qui pilote AutoCad.
Il est possible qu'un utilisateur veuille compléter une liste existante.
Dans la cellule A1, il y a le dossier qui contient les fichiers AutoCad.
Dans une colonne, sur chaque bloc traité, on trouve le nom du fichier dessin

Donc, en cas de complément, le dossier est pré-défini et il ne faut pas que l'utilisateur se promène dans l'arborescence de dossier pour y sélectionner des fichiers
Je pensais initialement qu'on pouvait "bloquer" le dossier via les Getopen ou FileMso "classiquement" utilisés.

Si tu as une autre idée (et je suis sûr que tu as ) n'hésites pas à proposer - A défaut, je passerai par le lien que j'ai mis pour poursuivre le développement.
Merci de l'intérêt, des conseils et autres tutos dont tu nous "abreuves" à longueur d'année..... A la tienne

Pour la réponse : La sélection doit (elle peux) être multiple et il est possible qu'il y ait beaucoup de fichiers (donc OUI et OUI)

Curt

[patricktoulon]

re

bonsoir curt
j'ai bricoler un userform pour qu'il se comporte comme une boite de dialog sauf que tu a que le dossier en parametre

alors en premier lieu le userform
1 label,1 textbox,1 listbox,2 boutons(annuler,ouvrir)

capture



le code dans le userform
j'ai prevu le cas ou tu fermerais le userform par la croix

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
Private Sub CommandButton1_Click()
With liste
For i = 0 To .ListCount - 1
If .Selected(i) Then a = a + 1:  tableau(a) = .List(i)
Next
End With
tableau(0) = Val(a)
End Sub
Private Sub CommandButton2_Click()
tableau(0) = "0"
End Sub
 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
' au cas ou tu aurais l'idée de fermer le userform par la croix et non le bouton annuler
If CloseMode = 0 Then tableau(0) = 0
End Sub

maintenant dans un module standard!!la fonction

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
 
Public tableau(1000) As Variant
 
Public Function GetopenFileNameX(dossier As String) As Variant()
    Dim q, t, fich, r
    t = Timer
    tableau(0) = 1000
    UserForm1.Show 0
    DoEvents
    fich = Dir(dossier & "*.*")
    Do: UserForm1.liste.AddItem fich: fich = Dir: Loop While fich <> ""
    UserForm1.doss = dossier
    Do: DoEvents: Loop While tableau(0) = 1000  'on reste bloqué ici tant que x =false le doevents permet de le modifier ailleurs c'est une variable public
    GetopenFileNameX = tableau: Unload UserForm1
End Function

la sub de test

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub test()
    ChDir "C:\Users\polux\Desktop\"'tu choisi le dossier que tu veux 
    listefichier = GetopenFileNameX(CurDir & "\")
    If listefichier(0) = 0 Then
        MsgBox " vous avez Annulé": Exit Sub
    Else
        'si l 'utilisateur a selectioné des fichier
        For i = 1 To listefichier(0)
            Debug.Print CurDir & "\" & listefichier(i)
        Next
    End If
End Sub

demonstration


fichier en exemple
en gros tu t'en sert casiment comme le vrai getopenfilname et il a casiment le meme comportement
sauf que pour verifier si tu a selectionné c'est if listefichier(0)>0

et pour boucler dessus on commence par le 1
voila

[curt]

Bonjour Patrick,

t'es un chef.... je n'ai même pas commencé à plancher sur le sujet (il a fait trop beau ce we pour m'y coller) que tu amènes une solution et en prime le fichier qui va bien, servi sur un plateau.

Bravo et merci.

Curt

[patricktoulon]

entre temps j'ai meme fait une autre version 3 minutes chrono

prend un userform apelle le "choixfichier" met lui les memes controls que dans mon exemplaire

met ce code dans le userform

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub CommandButton1_Click()
Dim i, a
With liste: For i = 0 To .ListCount - 1: a = a + IIf(.selected(i), 1, 0): Next: End With
Me.Tag = a: If a = 0 Then Me.Tag = 0
End Sub
Private Sub CommandButton2_Click()
Me.Tag = 0
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
' au cas ou tu aurais l'idée de fermer le userform par la croix et non le bouton annuler et bien on ne peut pas
If Me.Tag = "" Then Cancel = True:
End Sub

et maintenant la fonction

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
Public Type ch
    count As Long
    selected(1000) As String
End Type
Private Function GetopenFileNameX(dossier As String) As ch
    Dim q, t, fich, tt As ch
    t = Timer
    fich = Dir(dossier & "*.*")
    Do: DoEvents: choixfichier.liste.AddItem fich: fich = Dir: Loop While fich <> ""
    choixfichier.Show 0
    DoEvents
    choixfichier.doss = dossier
    Do: DoEvents: Loop While choixfichier.Tag = ""  'on reste bloqué ici tant que x =false le doevents permet de le modifier ailleurs c'est une variable public
    tt.count = Val(choixfichier.Tag)
    With choixfichier.liste
        For i = 0 To .ListCount - 1
            If .selected(i) Then a = a + 1: tt.selected(a) = .list(i)
        Next
    End With
    GetopenFileNameX = tt: Unload choixfichier
End Function

la sub pour tester

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub test()
    Dim listefichier As ch
    ChDir "C:\Users\polux\Desktop\"
    listefichier = GetopenFileNameX(CurDir & "\")
    If listefichier.count > 0 Then
        For i = 1 To listefichier.count
            Debug.Print CurDir & "\" & listefichier.selected(i)
        Next
    End If
End Sub

autrement dit tu
listefichier.count qui te donne le nombre de fichier selectionné
listefichier.selected qui contient les nom des fichiers selectionnés
allez exemplaire
je me suis bien amusé

[curt]

Bonjour Patrick,

y'a pas à dire, t'es un chef... c'est nickel
Bon du coup, tu m'as foutu la honte en disant que tu t'es bien amusé.....

Merci du méga coup de main
Bonne journée

Curt

[patricktoulon]

de rien
tu n' apas a avoir honte
ma reputation de farfelu n'est plus a faire c'est de notoriété publique que j'aime detourner tout pour tout en informatique
certains apprecient d'autre moins
mais c'est ma marque de fabrique je vais pas changer

[Arkham46]

Bonjour,

Je ne suis pas fan des boucles d'attente avec doEvents.
Est-ce qu'au niveau utilisation processeur ça se passe bien ?

[unparia]

Bonjour
je ne saurais trop approuver cette observation :

Je ne suis pas fan des boucles d'attente avec doEvents.
Est-ce qu'au niveau utilisation processeur ça se passe bien

Imaginons que l'utilisateur ait par exemple "un besoin naturel urgent" à satisfaire et qu'il rencontre un bavard qui l'accapare sur le chemin du retour --->> le processeur a intérêt à être doté d'un bon refroidisseur

[patricktoulon]

re

et 12% sans licecap(l'enregistreur en gif animé)

[patricktoulon]

re
et avec sleep le procc se remet a dormir

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
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Type ch
    count As Long
    selected(1000) As String
End Type
Private Function GetopenFileNameX(dossier As String) As ch
    Dim q, t, fich, tt As ch
    fich = Dir(dossier & "*.*")
    Do: DoEvents: choixfichier.liste.AddItem fich: fich = Dir: Loop While fich <> ""
    choixfichier.Show 0
    DoEvents
    choixfichier.doss = dossier
    Do: DoEvents: Sleep 100: Loop While choixfichier.Tag = "" 'on reste bloqué ici tant que x =false le doevents permet de le modifier ailleurs c'est une variable public
    tt.count = Val(choixfichier.Tag)
    With choixfichier.liste
        For i = 0 To .ListCount - 1
            If .selected(i) Then a = a + 1: tt.selected(a) = .list(i)
        Next
    End With
    GetopenFileNameX = tt: Unload choixfichier
End Function
Sub test()
    Dim listefichier As ch
    ChDir "C:\Users\polux\Desktop\"
    listefichier = GetopenFileNameX(CurDir & "\")
     If listefichier.count > 0 Then
        For i = 1 To listefichier.count
            Debug.Print CurDir & "\" & listefichier.selected(i)
        Next
    Else
    MsgBox "vous avez annulé"
   End If
End Sub