XL 2016 VBA - Ajouter numéro de page en pied de page sur Word

Anthonymctm

XLDnaute Occasionnel
Bonjour à tous ! :cool:

Depuis un fichier Excel, j'ai une macro qui me génère un fichier Word qui va bien.

A la fin de la macro, j'aimerais ajouter quelque ligne pour ajouter le numéro de page en pied de page sur le Word généré.

Voici la macro :

VB:
Function exist(feuille As String, nom As String) As Boolean
exist = False
On Error Resume Next
    x = Sheets(feuille).Range(nom).Address
    If Err.Number = 0 Then exist = True
On Error GoTo 0
End Function

Sub export_excel_to_word()
    Dim obj As Object
    Dim newObj As Object
    Dim sh As Worksheet
    Dim myFile

 
    Set obj = CreateObject("Word.Application")
    obj.Visible = True
    Set newObj = obj.Documents.Add
' obj.Selection.ParagraphFormat.LeftIndent = (20)
      With obj.Selection
        .PageSetup.TopMargin = (20)
        .PageSetup.LeftMargin = (17.5)
        .PageSetup.RightMargin = (20)
        .PageSetup.BottomMargin = (0)
    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")).Copy
        With obj.Selection
        .PasteSpecial Link:=True, DataType:=wdPasteBitmap, _
      Placement:=wdInLine, DisplayAsIcon:=False
     '   .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
      '  Placement:=wdInLine, DisplayAsIcon:=False
        .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")).Copy
        With obj.Selection
        .PasteSpecial Link:=True, DataType:=wdPasteBitmap, _
      Placement:=wdInLine, DisplayAsIcon:=False
        .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")).Copy
        With obj.Selection
        .PasteSpecial Link:=True, DataType:=wdPasteBitmap, _
      Placement:=wdInLine, DisplayAsIcon:=False
        .InsertBreak Type:=6
        End With
    End If
Next

     ThisWorkbook.Worksheets("CGV").Range("CGV").Copy
    obj.Selection.PasteSpecial Link:=True, DataType:=wdPasteBitmap, _
      Placement:=wdInLine, DisplayAsIcon:=False
      
     'Worddoc.Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers.Add _
        'PageNumberAlignment:=wdAlignPageNumberRight
                    
   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
 
    MsgBox "Export vers Word terminé", vbInformation + vbOKOnly, "Export vers Word"
 
    obj.Activate
    Set obj = Nothing
    Set newObj = Nothing
End Sub

Voilà, si vous savez comment faire, merci :)

PS : Vous voyez, j'ai tenté ce bout de code trouvé sur le forum
'Worddoc.Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers.Add _
'PageNumberAlignment:=wdAlignPageNumberRight

Mais évidement ça fonctionne pas, il faut déclarer le WordDoc et ça je sais pas faire.
 

Anthonymctm

XLDnaute Occasionnel
Bonjour Eric,

Oui oui c'est obj, mais comme la macro ne vient pas de moi, je ne sais pas comment le réutiliser

VB:
 obj.Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers.Add _
       PageNumberAlignment:=wdAlignPageNumberRigh

Mais ça ne fonctionne pas quand même :confused:
 

Statistiques des forums

Discussions
312 184
Messages
2 086 008
Membres
103 088
dernier inscrit
Psodam