Discussion :

[sorbetframboise]

Bonjour,

J'avais ce code pour enregistrer le document en PDF puis ne pas sauvegarder le document Word :

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
Sub EnregistrerPDF()
 
Dim CheminCompletExport As String
 
     With ActiveDocument
 
 
          CheminCompletExport = "C:\Users\GAE\Desktop\Rapport à récupérer\" & NomSansExtension(.Name) & ".PDF"
         .ExportAsFixedFormat OutputFileName:=CheminCompletExport, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False
 
    End With
    ActiveWindow.Close SaveChanges:=wdDoNotSaveChanges
 
 
End Sub

Je l'ai modifié en ce code mais il y a des erreurs de débogage

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Dim CheminCompletExport As String
 
     With ActiveDocument
 
 
          CheminCompletExport = "C:\Users\GAE\Desktop\Rapport à récupérer\" & NomSansExtension(.Name) & ".docm"
         .ExportAsFixedFormat OutputFileName:=CheminCompletExport, ExportFormat:=wdExportFormatwd, OpenAfterExport:=False
 
    End With
    ActiveWindow.Close SaveChanges:=wdDoNotSaveChanges
 
 
End Sub

je pense que l'erreur intervient du fait qu'il y ait un changement de format qui ne s'effectue pas mais je ne sais pas vraiment comment résoudre le problème.

Merci pour votre aide.

[Invité]

Bonjour,

Votre code comporte une fonction absente dans votre message. Donc en supposant qu'elle fonctionne correctement :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Sub EnregistrerPDF()
 
Dim CheminCompletExport As String
 
     With ActiveDocument
 
           CheminCompletExport = "C:\Users\GAE\Desktop\Rapport à récupérer\" & NomSansExtension(.Name) & ".PDF"
          .ExportAsFixedFormat OutputFileName:=CheminCompletExport, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False
          .Close SaveChanges:=False
 
    End With
 
End Sub

[sorbetframboise]

La fonction est présente dans mon code :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Function NomSansExtension(ByVal NomDoc As String) As String
 
Dim I As Integer, PositionPoint As Integer
 
    For I = Len(NomDoc) To 1 Step -1
        If Mid(NomDoc, I, 1) = "." Then
           PositionPoint = I
           Exit For
        End If
    Next I
    NomSansExtension = ActiveDocument.Words(10) & "-" & ActiveDocument.Words(12)
 
End Function

je ne l'ai juste pas mise car le problème ne vient pas de là, je n'arrive pas à enregistrer une copie du document en Word sans enregistrer le document lui même j'ai réussi en PDF mais je n'arrive pas à adapter mon code à du Word.

[Invité]

Je serais curieux de savoir ce que donne votre fonction chez vous....

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
 
Sub EnregistrerPDF()
 
Dim CheminCompletExport As String, NouveauNom As String
 
     NouveauNom = NouveauNom2(ActiveDocument)
     If NouveauNom = "Non valide" Then Exit Sub
 
     With ActiveDocument
          CheminCompletExport = "C:\Users\GAE\Desktop\Rapport à récupérer\" & NouveauNom
         ' CheminCompletExport = .Path & "\" & NouveauNom
          .SaveAs2 CheminCompletExport, wdFormatXMLDocumentMacroEnabled
          .Close SaveChanges:=False
    End With
 
End Sub
 
 
Function NouveauNom2(ByVal Doc As Document) As String
 
 Dim I As Integer, J As Integer
 
     With Doc
          J = 0
          For I = 1 To .Words.Count
              Select Case .Words(I).Text
                     Case "", " ", ",", Chr(10), Chr(13), Chr(11), Chr(12), "."  ' A compléter le cas échéant
 
                     Case Else
                        If J = 10 Then NouveauNom2 = .Words(I).Text
                        If J = 12 Then
                           NouveauNom2 = NouveauNom2 & "-" & .Words(I).Text & ".docm"
                           Exit For
                        End If
                        J = J + 1
              End Select
          Next I
     End With
     If J < 12 Then NouveauNom2 = "Non valide"
 
End Function

[sorbetframboise]

c'est parfait merci voici le code final, j'ai adapté votre solution à la mienne merci beaucoup.

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
 
 
Private Sub CommandButton1_Click()
 
Dim CheminCompletExport As String
 
     With ActiveDocument
 
 
          CheminCompletExport = "C:\Users\GAE\Desktop\Rapport à récupérer\" & NomSansExtension(.Name) & ".docm"
 
          .SaveAs2 CheminCompletExport, wdFormatXMLDocumentMacroEnabled
          .Close SaveChanges:=False
 
    End With
ActiveWindow.Close SaveChanges:=wdDoNotSaveChanges
 
End Sub
 
Function NomSansExtension(ByVal NomDoc As String) As String
 
Dim I As Integer, PositionPoint As Integer
 
    For I = Len(NomDoc) To 1 Step -1
        If Mid(NomDoc, I, 1) = "." Then
           PositionPoint = I
           Exit For
        End If
    Next I
    NomSansExtension = ActiveDocument.Words(10) & "-" & ActiveDocument.Words(12)
 
End Function

Ce que permet de faire ma fonction, c'est de nommer le document avec les données associées au document exemple :

Image d'un document non rempli en dehors du numéro d'OT :



Le document s'enregistre automatiquement à l'endroit voulu avec comme nom le numéro d'OT auquel il est associé.