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 |
