Discussion :

[Anthony47]

Bonjour le forum,

Grace à l'aide du forum il y a quelque mois, j'étais parvenu à bricoler une macro (qui fonctionne très bien) qui me permet de créer un fichier Word à partir de mes zones d'impression définies.

J'essaye maintenant d'ajouter un beau pied de page qui ressemble à ça :

Je ne connais pas la méthode pour y parvenir. Je vais vous montrer ce que j'ai tenté (vers la fin de la macro)
Le fichier qui lance la macro est utilisé par plusieurs utilisateurs (donc plusieurs pc)
Voici la macro :

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
Sub ET_Excel_to_word()
    On Error Resume Next
    Dim obj As Object, newObj As Object, sh As Worksheet, myFile$, n As Byte, nn As Byte, MonPDP As String, MonChemin As String, wdSeekCurrentPageFooter
 
Application.ScreenUpdating = False
    Set obj = CreateObject("Word.Application")
    obj.Visible = True
    Set newObj = obj.Documents.Add
     With obj.Selection.PageSetup
        .TopMargin = (20)
        .LeftMargin = (20)
        .RightMargin = (20)
        .BottomMargin = (0)
        .HeaderDistance = (0)
        .FooterDistance = (15)
    End With
 
For n = 1 To 3
    If exist("En_tête", "page_" & Format(n, "00")) Then
     ThisWorkbook.Worksheets("En_tête").Range("page_" & Format(n, "00")).CopyPicture Appearance:=xlScreen, Format:=xlPicture
       With obj.Selection
            nn = newObj.InlineShapes.Count + 1
            While newObj.InlineShapes.Count < nn: DoEvents: .Paste: Wend 'en attente de l'exécution
            .InsertBreak Type:=6
        End With
     End If
Next
For n = 1 To 15
    If exist("Descriptif", "page_" & Format(n, "00")) Then
     ThisWorkbook.Worksheets("Descriptif").Range("page_" & Format(n, "00")).CopyPicture Appearance:=xlScreen, Format:=xlPicture
        With obj.Selection
            nn = newObj.InlineShapes.Count + 1
            While newObj.InlineShapes.Count < nn: DoEvents: .Paste: Wend 'en attente de l'exécution
            .InsertBreak Type:=6
        End With
    End If
Next
For n = 1 To 5
    If exist("Carac_tech", "page_" & Format(n, "00")) Then
     ThisWorkbook.Worksheets("Carac_tech").Range("page_" & Format(n, "00")).CopyPicture Appearance:=xlScreen, Format:=xlPicture
        With obj.Selection
            nn = newObj.InlineShapes.Count + 1
            While newObj.InlineShapes.Count < nn: DoEvents: .Paste: Wend 'en attente de l'exécution
            .InsertBreak Type:=6
        End With
    End If
Next
ThisWorkbook.Worksheets("CGV").Range("CGV").CopyPicture Appearance:=xlScreen, Format:=xlPicture
    With obj.Selection
            nn = newObj.InlineShapes.Count + 1
            While newObj.InlineShapes.Count < nn: DoEvents: .Paste: Wend 'en attente de l'exécution
    End With
 
 newObj.Sections(1).Footers(1).PageNumbers.Add (1)
 
    'obj.Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers.Add _
      ' PageNumberAlignment:=wdAlignPageNumberRight
 
'!!!!!!!!!!! Ce que j'essaye d'ajouter !!!!!!!!!!!!
MonChemin = VBA.Environ("UserProfile") & "\AppData\Roaming\Microsoft\Document Building Blocks\1036\16\Building Blocks.dotx"
newObj.ActivePane.View.SeekView = wdSeekCurrentPageFooter
    newObj.Templates(MonChemin).BuildingBlockEntries("MCTM_PDP").Insert Where:=Selection.Range, RichText:=True
 
 
 
'!!!!!!!!!!! La suite de la macro !!!!!                 
   Application.CutCopyMode = False
    myFile = Replace(ActiveWorkbook.Name, "xlsm", "docx")   'remplacer "docx" par l'extension qui convient, si nécessaire
    newObj.SaveAs Filename:=Application.ActiveWorkbook.Path & "\" & myFile
 Application.ScreenUpdating = True
    MsgBox "Export vers Word terminé", vbInformation + vbOKOnly, "Export vers Word"
 
    obj.Activate
    Set obj = Nothing
    Set newObj = Nothing
End Sub

L'enregistreur de macro sur word m'a donné ce code, j'ai isolé le début du chemin pour que ça s'adapte en fonction de l'utilisateur.
Ca fonctionne si je lance le bout de code par word, mais pas depuis excel.

Je pensais à deux options :
-Mettre le pied de page sur un dossier partager sur notre réseau (je ne sais pas comment faire)
-réécrire dans la macro le pied de page directement (je ne sais pas comment faire non plus )

Voilà voilà