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 |
Partager