Renommer et deplace fichier word
aeromarche
Messages postés
8
Statut
Membre
-
aeromarche Messages postés 8 Statut Membre -
aeromarche Messages postés 8 Statut Membre -
Bonsoir tout le monde.
j aimerai que vou m aide svp.je sui debutant en langage Vba excel.je souhaite avoir un macro dans excel qui me permet de renommer un fichier word qui se trouve dans le bureau avex contenu de la cellule A1 e apres deplacer ce fichier vers un dossier .
svp j esprere que mon blem est bien compri et mersi d avance :)
j aimerai que vou m aide svp.je sui debutant en langage Vba excel.je souhaite avoir un macro dans excel qui me permet de renommer un fichier word qui se trouve dans le bureau avex contenu de la cellule A1 e apres deplacer ce fichier vers un dossier .
svp j esprere que mon blem est bien compri et mersi d avance :)
A voir également:
- Renommer et deplace fichier word
- Fichier bin - Guide
- Word 2013 - Télécharger - Traitement de texte
- Word et excel gratuit - Guide
- Fichier epub - Guide
- Renommer des fichiers en masse - Guide
3 réponses
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
