Macro Excel pour mise à jour de pieds de page de modèle word
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
slt floBER,
mais ton code ne fonctionne pas, je l'ai essayé sur 4 PC aucune chance!
Chez toi ca fonctionne?
bonjour
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
bonjour
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
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 & " " & Text_new2 & " " & Text_new3 & " " & 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 & "\" & 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
Bsr m3ellem1 et JMD,
en fait les modèles existent déjà
Merci pour ce retour, je teste ça rapidement