Renommer et deplace fichier word
Fermé
aeromarche
Messages postés
8
Date d'inscription
vendredi 19 août 2011
Statut
Membre
Dernière intervention
26 août 2011
-
20 août 2011 à 00:04
aeromarche Messages postés 8 Date d'inscription vendredi 19 août 2011 Statut Membre Dernière intervention 26 août 2011 - 20 août 2011 à 00:16
aeromarche Messages postés 8 Date d'inscription vendredi 19 août 2011 Statut Membre Dernière intervention 26 août 2011 - 20 août 2011 à 00:16
A voir également:
- Renommer et deplace fichier word
- Fichier rar - Guide
- Supprimer une page word - Guide
- Fichier host - Guide
- Renommer plusieurs fichiers - Guide
- Fichier iso - Guide
3 réponses
Utilisateur anonyme
Modifié par Adula-Kun le 20/08/2011 à 00:12
Modifié par Adula-Kun le 20/08/2011 à 00:12
J'ai compris ton problème ^^
La réponse dans le commentaire suivant !
La réponse dans le commentaire suivant !
Utilisateur anonyme
20 août 2011 à 00:11
20 août 2011 à 00:11
J'ai compris ce que tu veux, voici un bout de code qui pourrait t'aider :
N'oublie pas de changer dans la ligne "emplacement = "C:\Documents and Settings\etc"" le répertoire ""C:\Documents and Settings\etc"" par ton bureau...
Sub renommerword()
Dim oFSO As Scripting.FileSystemObject
Dim oFld As Scripting.Folder
Dim oFl As File
Set oFSO = New Scripting.FileSystemObject
emplacement = "C:\Documents and Settings\etc"
valeur = activesheet.cells(1,1).value
If oFSO.FolderExists(emplacement) Then
Else
i = MsgBox("Le répertoire n'existe pas." & Chr(10) & "Veuillez vérifier le chemin.", vbOKOnly, "Raté...")
Exit Sub
End If
Set oFld = oFSO.GetFolder(emplacement)
For Each oFl In oFld.Files
If UCase(Right(oFl.Name, 3)) = "DOC" Then
If InStr(oFl.Name, right(str(valeur),len(str(valeur))-1)) <> 0 Then
oFl.Name = Left(oFl.Name,len(oFl.name)-4) & "_" & right(str(valeur), len(str(valeur))-1) & ".doc"
End If
End If
Next
End Sub
N'oublie pas de changer dans la ligne "emplacement = "C:\Documents and Settings\etc"" le répertoire ""C:\Documents and Settings\etc"" par ton bureau...
Sub renommerword()
Dim oFSO As Scripting.FileSystemObject
Dim oFld As Scripting.Folder
Dim oFl As File
Set oFSO = New Scripting.FileSystemObject
emplacement = "C:\Documents and Settings\etc"
valeur = activesheet.cells(1,1).value
If oFSO.FolderExists(emplacement) Then
Else
i = MsgBox("Le répertoire n'existe pas." & Chr(10) & "Veuillez vérifier le chemin.", vbOKOnly, "Raté...")
Exit Sub
End If
Set oFld = oFSO.GetFolder(emplacement)
For Each oFl In oFld.Files
If UCase(Right(oFl.Name, 3)) = "DOC" Then
If InStr(oFl.Name, right(str(valeur),len(str(valeur))-1)) <> 0 Then
oFl.Name = Left(oFl.Name,len(oFl.name)-4) & "_" & right(str(valeur), len(str(valeur))-1) & ".doc"
End If
End If
Next
End Sub
aeromarche
Messages postés
8
Date d'inscription
vendredi 19 août 2011
Statut
Membre
Dernière intervention
26 août 2011
20 août 2011 à 00:16
20 août 2011 à 00:16
Adula-Kun mersi tro ca marche bien .juste il est un peu complique :) mai mersi bcp.si t en a un macro un peu facile tu me le passe.et mersi encore une foi tro tro j en besoin tro mersi
bon soire
bon soire
