Sélectionner plusieurs items dans une ListBox

**modus57** · 03/08/2025, 13h41

Bonjour,

Je souhaiterais renommer, déplacer un ou plusieurs fichiers d'une ListBox dans la deuxième ListBox, puis sélectionner et mettre en surbrillance dans cette dernière les fichiers renommés et déplacés.

Voici le code que j’utilise pour renommer et déplacer les fichiers aucuns soucis, en revanche ça ne fonctionne pas pour sélectionner et mettre en surbrillance tous les fichiers renommés et déplacés dans la deuxième ListBox, seul le dernier fichier est sélectionné :

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
Private Sub CommandButton11_Click() 'RENOMMER ET DÉPLACER LE OU LES FICHIERS SÉLECTIONNÉS VERS LA DROITE
    Dim GestionFichier As New Scripting.FileSystemObject
    Dim Extention, SourceG, DestinationD
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim dict As Object
    Dim i As Long, j As Long, x As Long
    ' Créer un dictionnaire
    Set dict = CreateObject("Scripting.Dictionary")
    Dim nouveauNom As String
    'boucle sur les éléments de la listbox Source
    For i = 0 To Source.ListCount - 1
        If Source.Selected(i) = True Then
            ' vérifier si le fichier existe
            If GestionFichier.FileExists(TextBox1 & Source.List(i)) Then
                Confirme = MsgBox("Confirmer renommer et déplacer le document sélectionné vers côté droit !")
                If Confirme = vbYes Then
                    Extention = Mid(Source.List(i), InStrRev(Source.List(i), ".") + 1)
                    SourceG = TextBox1 & Source.List(i)
                    nouveauNom = InputBox("Saisir le nouveau nom sans l'extention")
                    DestinationD = Application.WorksheetFunction.Trim(TextBox2 & nouveauNom & "." & Extention)
                    'renome et déplace le document sélectionné vers côté droit
                    Name (SourceG) As (DestinationD)
                Else
                    MsgBox "Abandon de la procédure"
                End If
            Else
                MsgBox "Le fichier n'existe pas"
                GoTo Line1
            End If
Line1:
        End If
    Next i
 
    Call MajListeFichiers
 
    trouve = False
    ' Parcourir les éléments de la ListBox
    For i = 0 To Dest.ListCount - 1
        If InStr(1, Dest.List(i), nouveauNom, vbTextCompare) > 0 Then
            ' Sélectionner et mettre en surbrillance l'élément trouvé
            Dest.Selected(i) = True
            trouve = True
        Else
            ' Désélectionner les autres éléments
            'Dest.Selected(i) = False
        End If
    Next i
End Sub

J’ai passé beaucoup temps et de recherches sans trouver de solution.

Comment modifier mon code pour sélectionner et mettre en surbrillance tous les fichiers renommés et déplacés dans la deuxième ListBox.

Merci d’avance pour votre aide.

**tototiti2008** · 03/08/2025, 14h03

Bonjour,

Est-ce que la seconde ListBox a la propriété Multiselect en fmMultiSelectMulti (1) ?

**modus57** · 03/08/2025, 14h13

Bonjour & merci tototiti2008,

Oui la seconde ListBox a la propriété Multiselect en fmMultiSelectMulti (1)

@+

**tototiti2008** · 03/08/2025, 14h28

Re,

Ce code fonctionne sur une ListBox en MultiselectMulti, peut-être analyser quand il est censé les sélectionner

Code :

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

1
2
3
4
5
6
7
8
9
Private Sub UserForm_Initialize()
Dim i As Long
    For i = 1 To 10
        Me.ListBox1.AddItem i
    Next i
    For i = 1 To 10 Step 2
        Me.ListBox1.Selected(i) = True
    Next i
End Sub

**modus57** · 03/08/2025, 15h06

Re,

Sauf erreur de ma part cela me parait difficile à l’initialisation de l’UserForm.

Dans mon code voici les phases principales :
1 – Sélection dans la ListBox1 des fichiers à renommer et à déplacer
2 – Renommage et déplacement des fichiers d’un dossier source vers un dossier destination
3 – Mise à jour de la liste des fichiers du dossier cible dans la ListBox2
4 - Sélection et mise en surbrillance des fichiers renommés et déplacés dans la ListBox2

**Qwazerty** · 03/08/2025, 22h02

Salut

Tu aurais un fichier démo pour éviter d'avoir à tout reconstruire pour tester?

++
Qwaz

**modus57** · 04/08/2025, 07h34

Bonjour Qwazerty,

Merci pour votre intérêt à cette discussion.

Ci-joint le fichier qui vous permettra de mieux cerner la question.

@+

**Qwazerty** · 04/08/2025, 09h35

Salut

Le problème vient du code.

Dans ta dernière boucle, celle qui doit sélectionner les éléments de la liste Dest, tu lui demandes de sélectionner les lignes correspondant à NouveauNom, hors NouveauNom contient un seul nom, le dernier à avoir été traité.

Soit tu les selectionnes au fur et à mesure que tu les ajoutes (je ne sais pas s le fait d'ajouter un élément annule la sélection courante (fait un test).
Soit tu conserves l'ensemble des nouveaux noms, le plus simple c'est de les mettre les uns à la suite des autre dans une variable texte avec ";" entre chaque, puis de faire un split(MaVariable,";") pour récupérer un tableau de noms.

Attention aux Msgbox a répétition, j'imagine que c'est pour faire des tests mais si ça n'est pas le cas, c'est pénible.
Il faudrait pouvoir donner les correspondance de noms dans un tableau, ou pouvoir donner un schéma de renommage, parce que les faire un par un, faut pas qu'il y en ait de trop.

++
Qwaz

**modus57** · 05/08/2025, 00h51

Bonsoir Qwazerty,

Voici ma solution:

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
Private Sub CommandButton11_Click() 'RENOMER ET DÉPLACER LE OU LES FICHIERS SÉLECTIONNÉS VERS LA DROITE
    Dim dossierSource As String
    Dim dossierDestination As String
    Dim i As Integer
    Dim ancienNom As String
    Dim nouveauNom As String
    Dim cheminAncien As String
    Dim cheminNouveau As String
 
    dossierSource = Me.TextBox1
    dossierDestination = Me.TextBox2
 
    If Me.TextBox1 = "" Then MsgBox "Choisir un répertoire avant de pousuivre la procédure !", , "CHOIX RÉPERTOIRE": Exit Sub
 
    For i = 0 To Source.ListCount - 1
        If Source.Selected(i) Then
            ancienNom = Source.List(i)
            nouveauNom = "Renom_" & ancienNom ' Exemple de renommage
            cheminAncien = dossierSource & ancienNom
            cheminNouveau = dossierDestination & nouveauNom
            ' Déplacement et renommage
            Name cheminAncien As cheminNouveau
            ' Mise à jour Dest
            Dest.AddItem nouveauNom
            Dest.Selected(Dest.ListCount - 1) = True
        End If
    Next i
 
    ' mise à jour liste fichiers
    Me.Source.Clear
    Dim fichier As String
    fichier = Dir(dossierSource & "*.*")
    Do While fichier <> ""
        Me.Source.AddItem fichier
        fichier = Dir
    Loop
    Me.TextBox6 = Source.ListCount & " fichier(s)"
End Sub

Il me reste à gérer le renomage en dur !

Si il y a plus simple, dites le moi.

Merci d'avance pour votre réponse.

**Qwazerty** · 05/08/2025, 15h22

Salut

Je n'avais pas regarder l'ensemble:

Externaliser des fonctionnalité (procédure dans un module), c'est très bien
Utiliser la même procédure avec juste une divergence en fonction d'un choix utilisateur (Dest ou source) c'est très bien aussi
Par contre, dans ces deux cas de figure c'est bien sur le fond mais incorrect dans la forme.

Je m'explique, admettons que vous souhaitiez, à partir d'un bouton sur votre feuille Excel, utiliser les fonctionnalités de vos procédures. Quand la procédure va devoir savoir si Dest ou Source... bug, car le userform n'est pas là. Idem si vous souhaitez importer des information dans le userform, c'est une mauvaise pratique que de récupérer ou de transmettre à un composant du userform des informations.

Au lieu d'aller chercher une info sur le user: Préférez utiliser une procédure qui attend un ou des paramètres.
Dans votre cas, vous pourriez transmettre un boolean (1=Source, 0=Dest). Dans le formulaire, au moment de l'appel, vous regardez si Dest ou Source
Dans le module

Code :

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

1
2
3
4
5
6
7
Sub MonOperation(ByVal EstSource as boolean)
   If EstSource then
      '....
   else
      '....
   end if
End sub

Dans le formulaire

Code :

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

1
2
3
Sub BtnAjoutClick()
   MonOpération Source.value
End Sub

Idem pour rapatrier une information, cette fois, il faut utiliser une fonction au lieu d'une procédure
Dans le Module

Code :

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

1
2
3
4
5
6
7
Function ListeFichier(Rep as string) as String 'On retourne les noms de fichiers séparés par des ";" ... Ou As Variant si on veut transmettre un tableau
   'Code qui liste les fichiers contenu dans le répertoire Rep
   'MaVariableContenantLaListe = ....
 
   'On retourne le résultat
   ListeFichier = MaVariableContenantLaListe
End Function

Dans le formulaire

Code :

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

1
2
3
4
5
Sub Init()
   MaListe = ListeFichier(TextBoxRep.text)
 
   Dest.list = ....MaListe...
End Sub

En procèdent ainsi, vous êtes libre de réutiliser cette fonction et cette procédure dans n'importe quelle partie de votre fichier.

Par contre ne cherchez pas à externaliser tout le code du formulaire, si tdu code n'est utilisait que dans le formulaire, laisser le dedans/

Code :

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

1
2
 
Name (SourceD) As (DestinationG)

Je ne comprends pas cette partie, si c'est pour renommer vos fichiers, vous avez déclarer des instances Fso, regardez plutôt la doc pour avoir des information sur ce qui peut-être fait avec.

++
Qwaz

**modus57** · 09/08/2025, 10h07

Bonjour Qwazerty,

Navré pour ma réponse tardive en raison d’un contre-temps.

Au lieu d'aller chercher une info sur le user: Préférez utiliser une procédure qui attend un ou des paramètres.
Dans votre cas, vous pourriez transmettre un boolean (1=Source, 0=Dest). Dans le formulaire, au moment de l'appel, vous regardez si Dest ou Source.
…

Dans mon principe, le but c’est d’utiliser notamment une procédure unique pour lister les fichiers dans la Listbox « Source » ou « Dest ».

Je ne comprends et ne vois pas comment mettre en application votre solution.

**Qwazerty** · 09/08/2025, 12h34

Salut

Je n'ai pas fait de test du code mais ça ressemblerait à un truc comme ça

Dans le module

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
Option Explicit
 
Function MajListeFichiers(Optional Source As Boolean = True) As Variant
    Dim Racine, fs, Dossier, ligne, f
    Dim fe As Worksheet
    Dim rgTableau As ListObject
    Call VarCommunes ': appelant
 
    If Source Then
        Set fe = Sheets("BD Source")
        Set rgTableau = fe.ListObjects("TableauSource")
        'Set Racine = F_Transfert.TextBox1
    Else
        Set fe = Sheets("BD Destination")
        Set rgTableau = fe.ListObjects("TableauDestination")
        'Set Racine = F_Transfert.TextBox2
    End If
    Application.DisplayAlerts = False
    If Not Range(rgTableau).ListObject.DataBodyRange Is Nothing Then Range(rgTableau).ListObject.DataBodyRange.Delete
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set Dossier = fs.GetFolder(Racine) 'DossierRacine
    'Si aucun dossier n'est sélectionné, quitte la procédure
'Erreur ici je pense, il faut tester le contenu de Dossier pas de Racine
    If Dossier Then
'Mieux vaut inclure du code entre deux balise plutôt que de mettre des exit function/sub, c'est un conseil, ça rend plus simple le debugage (à mon sens)    
        'Vérifier si le dossier contient des fichiers ou des sous-dossiers
        If Dossier.Files.Count <> 0 Then
            'ligne = 1 'inutile
            'ligne = ligne + 2 'inutile
            'il n'est pas utile de faire ça
            ligne = 3 'suffit
            For Each f In Dossier.Files
                If Not (f.Attributes And 2) Then 'exclusion des fichiers cachés
                    fe.Cells(ligne, 1) = f.Name
                    fe.Cells(ligne, 2) = Format(f.DateLastModified, "yyyy/mm/dd")
                    fe.Cells(ligne, 3) = f.Size
                    ligne = ligne + 1
                End If
            Next
            fe.Cells(1, 1) = Dossier.Path
'Bien compliqué : Range(rgTableau).ListObject = rgTableau, autant utiliser directement rgTableau
            fe.Cells(1, 2) = rgTableau.ListRows.Count & " fichier(s)"
            With rgTableau.Sort
                .SortFields.Clear
                .SortFields.Add key:=rgTableau.ListColumns("Date modif").Range, Order:=xlAscending
            End With
 
'idem ici, profite plutôt de la structure d'objet directement
            MajListeFichiers = rgTableau.Range.Value
 
'Les deux lignes suivantes seront à traiter dans la procédure appelante
            'objList.SetFocus
 
            'objText2 = objList.ListCount & " fichier(s)"
            Call TriSansDoublonsBD ': appelant
        End If
    End If
End Function

Dans le formulaire

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
Line1:
        End If
    Next i
 
'Pourquoi faire une selection avant de mettre à jour la liste?
    Source.Selected(0) = False
    Dest.Selected(0) = True
 
    Dest.List = MajListeFichiers(False)
    'On fait le focus
    Dest.SetFocus
    'On met à jour les infos
    text1.Text = Dest.ListCount & " fichier(s)"
    'Call MajListeFichiers ': appelant
 
    'Me.ChoixDest = True
    'Call MajListeFichiers ': appelant
 
    Source.List = MajListeFichiers ' (True) : On peut omettre true, c'est la valeur qu'on a indiquée par défaut
 
    'On fait le focus
    Source.SetFocus
    'On met à jour les infos
    text2.Text = Source.ListCount & " fichier(s)"
 
    trouve = False
    ' Parcourir les éléments de la ListBox

En pratiquant ainsi, s'il vous vient l'envie de faire appel à MajListeFichiers dans un autre formulaire ou dans un module, il suffira de l'appeler

Code :

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

VariableMaListe = MajListeFichiers (true ou false)

et vous n'aurez pas de lien avec un formulaire qui n'est pas chargé.

++
Qwaz

**modus57** · 09/08/2025, 14h53

Re bonjour Qwazerty,

Merci beaucoup pour votre implication et réactivité.

Je vais examiner et tester votre code et et je vous tiens au courant.

@+

**modus57** · 10/08/2025, 19h24

Bonjour Qwazerty,

Ci-joint un nouveau classeur, code dépouillé et optimisé, en partant de votre principe.

@+

PS : nouveau fichier corrigé (le précédent contenant une bourde)

**modus57** · 11/08/2025, 09h46

Bonjour

Voici le classeur modifié utilisant des functions.

Merci @ tous pour votre intérêt, implication et participation à cette discussion.

**Qwazerty** · 11/08/2025, 16h00

Salut

Ça me semble déjà plus facile à maintenir, qu'en pensez-vous?

Pourquoi passer par des tableaux sur une feuille Excel?

Utilisez votre logiciel un peu et je pense que les inputbox vont rapidement vous sortir par les yeux

Je pense que vous devriez réfléchir à un autre moyen pour que l'utilisateur puisse saisir les nouveaux noms.
Peut-être simplement une colonne de plus dans destination permettant de placer les nouveaux noms en regard des anciens.

Je trouve aussi un peu compliqué la saisie des rep source et destination, ne serait-il pas plus facile pour l'utilisateur d'avoir 2 champs Source et destination avec des bouton "..." permettant de choisir le répertoire idoine?

Pour le code, j'ai mis quelques commentaires

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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
Option Explicit
 
Function AlimenterTS(ByRef sourceListBox As MSForms.listBox, ByRef destListBox As MSForms.listBox)
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim tbl1 As ListObject, tbl2 As ListObject
    Dim i1 As Long, i2 As Long
    Dim nouvelleLigne1 As ListRow, nouvelleLigne2 As ListRow
 
    If sourceListBox.ListCount > 0 Then
        Application.DisplayAlerts = False
 
        Set ws1 = ThisWorkbook.Sheets("BD Source")
        Set tbl1 = ws1.ListObjects("TableauSource")
'Autant profiter des variables
        If Not tbl1.DataBodyRange Is Nothing Then tbl1.DataBodyRange.Delete
 
        ' Boucle sur chaque ligne de la ListBox "sourceListBox"
        For i1 = 0 To sourceListBox.ListCount - 1
            Set nouvelleLigne1 = tbl1.ListRows.Add
            nouvelleLigne1.Range(1, 1).Value = sourceListBox.List(i1, 0) ' Colonne 1 : Nom fichier
            'nouvelleLigne.1Range(2, 2).Value = sourceListBox.List(i1, 1) ' Colonne 2 : Date modif
            'nouvelleLigne1.Range(2, 3).Value = sourceListBox.List(i1, 2) ' Colonne 3 : Taille
        Next i1
 
 
        Set ws2 = ThisWorkbook.Sheets("BD Destination")
        Set tbl2 = ws2.ListObjects("TableauDestination")
'Idem
        If Not tbl2.DataBodyRange Is Nothing Then tbl2.DataBodyRange.Delete
 
        ' Boucle sur chaque ligne de la ListBox "destListBoxListBox"
        For i2 = 0 To destListBox.ListCount - 1
            Set nouvelleLigne2 = tbl2.ListRows.Add
            nouvelleLigne2.Range(1, 1).Value = destListBox.List(i2, 0) ' Colonne 1 : Nom fichier
            'nouvelleLigne2.Range(2, 2).Value = destListBoxListBox.List(i2, 1) ' Colonne 2 : Date modif
            'nouvelleLigne2.Range(2, 3).Value = destListBoxListBox.List(i2, 2) ' Colonne 3 : Taille
        Next i2
        Application.DisplayAlerts = True
    Else
        MsgBox "Choisir un répertoire avant de pousuivre la procédure !", , "CHOIX RÉPERTOIRE": Exit Function
    End If
End Function
 
Function DéplacerEtRenommerFichiers(ByRef sourceListBox As MSForms.listBox, _
                                                            ByRef destinationListBox As MSForms.listBox, _
                                                            ByVal sourceFolder As String, _
                                                            ByVal destinationFolder As String)
 
    Dim i As Long
    Dim fichierNom As String
    Dim nouveauNom As String
    Dim cheminSource As String
    Dim cheminDestination As String
 
    ' Vérifier que les dossiers existent
    If Dir(sourceFolder, vbDirectory) = "" Or Dir(destinationFolder, vbDirectory) = "" Then
        MsgBox "Un des dossiers spécifiés n'existe pas.", vbExclamation
        Exit Function
    End If
 
    ' Parcourir les éléments sélectionnés dans la ListBox source
    For i = 0 To sourceListBox.ListCount - 1
        If sourceListBox.Selected(i) Then
            fichierNom = sourceListBox.List(i)
'attention ici, tu tests si ton répertoire existe au début mais si la liste de fihciers n'est pas celle de ce rép... Il vaudrait mieux tester ici que ce fichier existe
            cheminSource = sourceFolder & "\" & fichierNom
 
            ' Exemple de renommage : ajouter "new " au nom
'Il manquerait pas & "_New" quelque part pour proposer cette modification à l'utilisateur? Sinon quel est le but de découper FichierNom?
            nouveauNom = Application.InputBox("Saisir le nouveau nom du fichier et son extention", "RENOMMER & DÉPLACER FICHIER(S)", _
                Left(fichierNom, InStrRev(fichierNom, ".") - 1) & "_New" & Mid(fichierNom, InStrRev(fichierNom, ".")), Type:=2)
 
            cheminDestination = destinationFolder & "\" & nouveauNom
 
'Je ne connaissais pas cette fonction
            ' Déplacement et renommage
            Name cheminSource As cheminDestination
 
            ' Mise à jour Destination et sélection fichiers déplacés
            destinationListBox.AddItem nouveauNom
            destinationListBox.Selected(destinationListBox.ListCount - 1) = True
        End If
    Next i
 
    ' Supprimer les éléments déplacés de la ListBox source
'Pourquoi ne pas le faire dans la boucle précédente (en bouclant en step -1 bien sûr)?
    For i = sourceListBox.ListCount - 1 To 0 Step -1
        If sourceListBox.Selected(i) Then
            sourceListBox.RemoveItem i
        End If
    Next i
End Function

Vous avez fait le choix de typer vos variables en Listbox. Ce qui veut dire que ces fonctions ne peuvent être appelé qu’exclusivement en leur transmettant des listbox. >
Si on prend DéplacerEtRenommerFichiers(), quel est l’intérêt de passer les listbox, si au lieux de ça vous transmettez un tableau ByRef contenu dans une varable de type Variant avec 5 colonnes par exemple
0-index dans la tableau source
1- Chemin\nom d'oringine
2-Index tableau destination
3- Nouveau chemin\nom
4- Un retour d'exécution
Autant de ligne que de fichiers à renommer déplacer. Vous bouclez sur le tableau, vous utilisez les donnée de la colonne 1 et 2 pour la fonction Name
Vous regardez avec un dir si le nouveau fichier est bien en place pour renseigner la colonne 3

Code :

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

Colonne3= Dir(Colonne2)<>false

Une fois l'appel fait à partir du UserForm, vous mettez à jour vos ListBox en fonction des données présentes dans votre variable tableau

Gros avantage, vous pouvez utiliser cette fonction pour faire du renommage sans passer par un userform contenant des listbox

++
Qwaz

Sélectionner plusieurs items dans une ListBox

Macros et VBA Excel

Discussions similaires

Partager

Partager