Macro Excel pour mise à jour de pieds de page de modèle word

Question

Bonjour, ayant plusieurs dizaines de modèles word (.dotx voire.dot pour certains) à mettre à jour, je pensais utiliser un code sous excel (je débute en excel et ne connais pas suffisamment word pour le faire à partir de cet applicatif).

J'ai cherché pas mal sur le net mais n'est trouvé qu'en partie ce que je cherche et bute sur un élément...

Je recherche donc une bonne âme pour me dépanner...

D'avance, MERCIIII

Voici le code :

Sub TEST()
Dim docWord As Word.Document
Dim appWord As Word.Application
Dim Chemin As String
Dim Classeur As String

Dim Text_new1 As String, Text_new2 As String, Text_new3 As String, Text_new4 As String, Text_New As String

Dim Text_old1 As String, Text_old2 As String, Text_old3 As String, Text_old4 As String, text_old As String
Dim Ficarrive As String

Dim Dossier As Object
Dim Fichier As Object

'''Nécessite d'activer la référence "Microsoft Word xx.x Object Library" :
Ficarrive = ThisWorkbook.Name
Chemin = Sheets("PARAm").Range("chemin").Value
Text_new1 = Sheets("PARAm").Range("new_1").Value
Text_new2 = Sheets("PARAm").Range("new_2").Value
Text_new3 = Sheets("PARAm").Range("new_3").Value
Text_new4 = Sheets("PARAm").Range("new_4").Value

Text_New = Text_new1 & " " & Text_new2 & " " & Text_new3 & " " & Text_new4
text_old = Text_old1
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
For Each Fichier In Dossier.Files
    Set appWord = CreateObject("Word.Application")
    appWord.Visible = True

    Documents.Open Chemin & "\" & Fichier.Name _
        , ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
        PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
        WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
        wdOpenFormatAuto, XMLTransform:=""

'Set docWord = WordApp.Documents.Open(Chemin & "\" & Fichier.Name)'adapter le chemin
  Set docWord = Fichier 'bout de code récupéré, mais qui ne convient pas ....

    With docWord.Sections(1)
        .Headers(wdHeaderFooterPrimary).Range.Text = Text_New
        .Headers(wdHeaderFooterPrimary).Range.Paragraphs.Alignment = wdAlignParagraphCenter
        .Footers(wdHeaderFooterPrimary).PageNumbers.Add
    End With

    'enregistrer le document en .dotx
 Application.DisplayAlerts = False
 ActiveWorkbook.Close
Next Fichier

Set docWord = Nothing
Set appWord = Nothing
    End Sub

12outil-modif-bas-page.xlsm (21.97 Ko)

m3ellem1 · Answer

Slt floBER, mais ton code ne fonctionne pas, je l'ai essayé sur 4 PC aucune chance! Chez toi ca fonctionne...

jmd · Answer

Salut m3ellem au passage ne vaut-il pas mieux, une fois pour toutes, insérer dans chaque modèle Word un champ. Créer un Word (ou autre logiciel) avec ce que tu veux afficher (par exemple une adresse) dans chaque dot, tu insère un "Objet" (voir les menus de ton Word) et tu navigues vers le fichier en question quand tu en as besoin, tu modifies le fichier contenant l'adresse. mais mon avis perso est qu'il est déraisonnable de créer autant de dot à quoi servent-ils ? à te relire amitiés...

m3ellem1 · Answer

Slt jmd, je suis tout à fait d'accord avec toi! Mais bon si vraiment c'est nécessaire voici la macro avec correctures. ET n'oublie pas d'activer la référence "Microsoft Word xx.x Object Library" Sub TEST() Dim appWord As New Word.Application Dim docWord As Word.Document Dim Chemin As String Dim Classeur As String Dim Text_new1 As String, Text_new2 As String, Text_new3 As String, Text_new4 As String, Text_New As String Dim Text_old1 As String, Text_old2 As String, Text_old3 As String, Text_old4 As String, text_old As String Dim Ficarrive As String Dim Dossier As Object Dim Fichier As Object '''Nécessite d'activer la référence "Microsoft Word xx.x Object Library" : Ficarrive = ThisWorkbook.Name Chemin = Sheets("PARAm").Range("chemin").Value Text_new1 = Sheets("PARAm").Range("new_1").Value Text_new2 = Sheets("PARAm").Range("new_2").Value Text_new3 = Sheets("PARAm").Range("new_3").Value Text_new4 = Sheets("PARAm").Range("new_4").Value Text_New = Text_new1 &amp; " " &amp; Text_new2 &amp; " " &amp; Text_new3 &amp; " " &amp; Text_new4 text_old = Text_old1 Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin) For Each Fichier In Dossier.Files Set objWord = CreateObject("Word.Application") objWord.Visible = True Set docWord = appWord.Documents.Open(Chemin &amp; "\" &amp; Fichier.Name) 'adapter le chemin , OpenAndRepair:=True With docWord.Sections(1) .Headers(wdHeaderFooterPrimary).Range.Text = Text_New .Headers(wdHeaderFooterPrimary).Range.Paragraphs.Alignment = wdAlignParagraphCenter .Footers(wdHeaderFooterPrimary).PageNumbers.Add End With docWord.Save Application.DisplayAlerts = False docWord.Close objWord.Quit Next Fichier Set docWord = Nothing Set objWord = Nothing End Sub...