VBA用excel的内容批量替换Word的页眉内容

smorth

求助一下各位大神。我想用excel的内容批量替换Word的内容，正文部分能正常替换，但是页眉部分没有被替换，网上找了各种资料，无果~

先上代码：

1. 主过程：

复制代码

1. 调用的函数：
   
2. Private Function iRePlace(ByVal iFilePath As String, ByVal Content_Text As String, ByVal Replacement_Text As String)
   
3. 
   
4.     Dim MaFeuille As Worksheet
   
5.     Set MaFeuille = Sheets("项目表")
   
6.    
   
7.     Dim File As String
   
8. '    File = ActiveWorkbook.Path & "" & "nomfichier.docx"
   
9. 
   
10.     Dim Word_APP As Object
    
11.     Set Word_APP = CreateObject("Word.Application")
    
12.     With Word_APP
    
13.         .Visible = True
    
14. '        .WindowState = 1                                        'value for wdWindowStateMaximize
    
15.     End With
    
16.    
    
17.     Dim Word_Fichier As Object
    
18.    
    
19.     Set Word_Fichier = Word_APP.Documents.Open(iFilePath)
    
20.    
    
21.     With Word_Fichier.Range.Find
    
22.         .Text = Content_Text
    
23.         .Replacement.Text = Replacement_Text
    
24. '        .Execute Replace:=2                                     'value for wdReplaceAll
    
25.         
    
26.     End With
    
27.   
    
28.    
    
29.    
    
30. '=========================没有成功替换的部分=========================
    
31. 
    
32.     Dim Footr As Word.HeaderFooter
    
33.    
    
34.     For Each Footr In Word_Fichier.Sections(1).Footers
    
35. 
    
36.         With Footr.Range.Find
    
37.         
    
38.             .Text = "P-FCCD14O-01"
    
39.             .Replacement.Text = "P-TSPS01-01"
    
40.             
    
41.             .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindStop
    
42.             
    
43.         End With
    
44.         
    
45.     Next Footr
    
46.    
    
47. '===============================================================
    
48.    
    
49.    
    
50.     Word_Fichier.Save
    
51.     Word_APP.Quit
    
52.    
    
53.    
    
54. End Function

复制代码

smorth

主过程的代码好像GG了，重新发一下：

1. Private Sub SOP()
   
2. 
   
3.     Dim iRow&, SorcePath$, iFileName$, iFilePath$
   
4.    
   
5.     With ThisWorkbook.Sheets("项目表")
   
6.    
   
7.         SorcePath = "C:\Users\曾建波\Desktop\流式项目\批处理文件\01.SOP P01"    '待处理文件的地址
   
8.         
   
9. '        For iRow = 2 To .UsedRange.Rows.Count
   
10.         For iRow = 2 To 3                                                       '仅用于测试
    
11.         
    
12.             iFileName = "SOP P01 (" & iRow - 1 & ").docx"
    
13.             iFilePath = SorcePath & "" & iFileName
    
14.             
    
15.             Call iRePlace(iFilePath, "TSPS01", .Cells(iRow, 2).Value)
    
16.         Next iRow
    
17.    
    
18.     End With
    
19. 
    
20. End Sub

复制代码

smorth

自我解答：

1. '=========================没有成功替换的部分=========================
   
2. 
   
3.     Dim Footr As Word.HeaderFooter
   
4.    
   
5.     For Each Footr In Word_Fichier.Sections(1).Headers
   
6. 
   
7.         With Footr.Range.Find
   
8.         
   
9.             .Text = "P-FCCD14O-01"
   
10.             .Replacement.Text = "P-TSPS01-01"
    
11.             
    
12.             .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindStop
    
13.             
    
14.         End With
    
15.         
    
16.     Next Footr

复制代码

smorth

Footers            用于页脚；
Headers           用于页眉；

batmanbbs

眉脚弄反了呀