Discussion :

[VincentDuSud]

Bonjour,

J'ai créé une macro pour renommer un fichier Word en cours d'utilisation (contenant la date dans le nom).

A la fin, je souhaite détruire l'ancien fichier.
Avec Word 2010, le code ci-dessous fonctionnait très bien.

Avec Word 2019 la méthode Delete ne fonctionne plus ...

Une idée ?

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
 
 
Sub EnregistreDateNouvelle()
'
' EnregistreDateNouvelle Macro
'
'
    Dim NomDeFichierAvant, MonFichier, MonRepertoire, Extension, NomIsole, NomCourt, NomComplet, NomSauve As String
    Dim LongueurNom, LongueurExtension As Currency
    Dim DateJour As Date
    Dim DateDuJour, MonJour, MonMois, MonAnnee As String
 
    DateJour = Date
    DateDuJour = Str(DateJour)
    MonJour = Mid(DateDuJour, 2, 2)
    MonMois = Mid(DateDuJour, 5, 2)
    MonAnnee = Mid(DateDuJour, 10, 2)
 
    NomDeFichierAvant = ActiveDocument.FullName
    MonRepertoire = ActiveDocument.Path
 
    Set FichierSysteme = CreateObject("Scripting.FileSystemObject")
    Set FichierADetruire = FichierSysteme.GetFile(NomDeFichierAvant)
 
    MonFichier = ActiveDocument.Name
    MonFormat = wdFormatXMLDocument ' pour Word 2010 - defaut = .docx
 
    LongueurNom = Len(MonFichier)
    LongueurExtension = LongueurNom - InStr(1, MonFichier, ".") + 1
    Extension = Right(MonFichier, LongueurExtension)
    NomIsole = Left(MonFichier, LongueurNom - LongueurExtension)
    NomCourt = Left(NomIsole, LongueurNom - LongueurExtension - 6)
    NomComplet = NomCourt + MonAnnee + MonMois + MonJour + Extension
    NomSauve = MonRepertoire + "\" + NomComplet
 
    ChDir MonRepertoire
 
    ActiveDocument.SaveAs2 FileName:=NomSauve, _
        FileFormat:=MonFormat, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False, CompatibilityMode:=14
 
    If NomComplet <> MonFichier Then
 
    Resultat = FichierADetruire.Delete
 
 
    End If
 
End Sub

Merci de votre aide.
Cordialement

[Invité]

Bonjour,

• Votre code sauvegarde votre fichier en .docx qui ne peut recevoir des macros, il faut que votre fichier soit déjà en .docm.
• Par ailleurs, je ne vois pas très bien comment vous pouviez supprimer votre fichier avant... La commande pour détruire ce fichier pourrait plutôt être :

Code :

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

1
2
 
         If FichierADetruire.Name <> ActiveDocument.Name Then FichierSysteme.DeleteFile FichierADetruire

[VincentDuSud]

Bonjour Éric,

Merci de votre retour.

Les macros sont stockées dans normal.dotm, donc le fichier Word sauvegardé est bien un .docx

"Par ailleurs, je ne vois pas très bien comment vous pouviez supprimer votre fichier avant... "
Je n'ai jamais eu de problème avec Word 2010, ma macro fonctionnait très bien ;-)

Avec votre code, j'ai le message "Erreur d'exécution 70 - Permission refusée" ...
J'ai eu aussi ce message avec une autre tentative : " Kill (FichierADetruire)"

Avec mon code initial "Resultat = FichierADetruire.Delete" j'ai un autre message d'erreur "Erreur d'exécution 70 - Le document XML doit contenir un élément de niveau supérieur."

Merci de votre aide.
Cordialement

[Invité]

Ce code est placé dans un module du fichier qui sera dupliqué, puis supprimé. Il est donc sauvegardé en tant .docm, il fonctionne correctement chez moi.

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
 
Option Explicit
 
Sub EnregistreDateNouvelle()
 
Dim MonRepertoire, NomCourt, NomComplet, NomSauve As String
Dim FichierSysteme As Object, FichierADetruire As Object
 
    On Error GoTo Fin
 
    With ActiveDocument
 
         MonRepertoire = .Path
 
         Set FichierSysteme = CreateObject("Scripting.FileSystemObject")
         Set FichierADetruire = FichierSysteme.GetFile(.FullName)
 
         NomCourt = Split(.Name, ".")(0)
         NomComplet = Mid(NomCourt, 1, Len(NomCourt) - 6) & DateSauvegarde(Date) & "." & Split(.Name, ".")(1)
         NomSauve = MonRepertoire & "\" & NomComplet
 
         ChDir MonRepertoire
 
         .SaveAs2 FileName:=NomSauve, _
                  FileFormat:=wdFormatXMLDocumentMacroEnabled, LockComments:=False, Password:="", _
                  AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
                  EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
                  :=False, SaveAsAOCELetter:=False
 
         'Debug.Print FichierADetruire.Name & ", " & .Name
         If FichierADetruire.Name <> ActiveDocument.Name Then FichierSysteme.DeleteFile FichierADetruire
 
    End With
 
    GoTo Fin
 
Fin:
 
    Set FichierSysteme = Nothing
    Set FichierADetruire = Nothing
 
End Sub
 
Function DateSauvegarde(ByVal MaDate As Date) As String
 
Dim MonTableau As Variant
 
    MonTableau = Split(MaDate, "/")
    DateSauvegarde = Mid(MonTableau(2), 3, 4) & MonTableau(1) & MonTableau(0)
 
End Function

[VincentDuSud]

Merci encore de votre aide.

Il est nécessaire que le fichier sauvegardé soit .docx et non .docm

Je continue de chercher ...

Cdlt

[Invité]

Il faut que le fichier contenant la macro soit différent des fichiers qu'il traite.

[Invité]

En mettant ce code dans un module standard de votre Normal.dotm, cela fonctionne sans problème. Le fichier actif est un fichier .docx, la sauvegarde est donc au format wdFormatXMLDocument.

Perso : Je ne mets rien dans mon Normal.dotm pour éviter de le corrompre. C'est pour cette raison que je vous suggérais de mettre ce code dans un fichier .docm. Je vais donc vite supprimer ce que je viens de modifier.

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
 
Option Explicit
 
Sub EnregistreDateNouvelle()
 
Dim MonRepertoire, NomCourt, NomComplet, NomSauve As String
Dim FichierSysteme As Object, FichierADetruire As Object
 
    On Error GoTo Fin
 
    With ActiveDocument
 
         MonRepertoire = .Path
 
         Set FichierSysteme = CreateObject("Scripting.FileSystemObject")
         Set FichierADetruire = FichierSysteme.GetFile(.FullName)
 
         NomCourt = Split(.Name, ".")(0)
         NomComplet = Mid(NomCourt, 1, Len(NomCourt) - 6) & DateSauvegarde(Date) & "." & Split(.Name, ".")(1)
         NomSauve = MonRepertoire & "\" & NomComplet
 
         ChDir MonRepertoire
 
         .SaveAs2 FileName:=NomSauve, _
                  FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
                  AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
                  EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
                  :=False, SaveAsAOCELetter:=False
 
         'Debug.Print FichierADetruire.Name & ", " & .Name
         If FichierADetruire.Name <> ActiveDocument.Name Then FichierSysteme.DeleteFile FichierADetruire
 
    End With
 
    GoTo Fin
 
Fin:
 
    Set FichierSysteme = Nothing
    Set FichierADetruire = Nothing
 
End Sub
 
Function DateSauvegarde(ByVal MaDate As Date) As String
 
Dim MonTableau As Variant
 
    MonTableau = Split(MaDate, "/")
    DateSauvegarde = Mid(MonTableau(2), 3, 4) & MonTableau(1) & MonTableau(0)
 
End Function

[VincentDuSud]

Bonjour à tous,

Merci Éric : ton code fonctionne !

Mais le mien, l'initial, fonctionne aussi !
Avec juste une petite différence : il faut supprimer ", CompatibilityMode:=14" qui ne concerne que Word 2010 !!!

Comme quoi ça tient à pas grand chose ...

Merci de ton aide : ça m'a obligé à comprendre ce qui n'allait pas.

A bientôt
Cordialement

P.S. : on peut donc clôturer ce fil ;-) Je t'en laisse le soin si tu veux faire un dernier commentaire ...

[Invité]

Bonjour,

Je n'ai rien à ajouter. Il n'y a que toi qui peut clôturer ce message.

A+.