ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 197|回复: 0

[求助] 替换word模板正文内容以及页眉内容

[复制链接]

TA的精华主题

TA的得分主题

发表于 2024-7-19 14:13 | 显示全部楼层 |阅读模式
现在的code替换模板正文内的文字没问题,但是不知道如何能够替换页眉的文字

有没有大佬能帮忙!


Sub Generate_word()
On Error GoTo Err_cmdExportToWord_Click
    Dim objApp As Object 'Word.Application
    Dim objDoc As Object 'Word.Document
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim strTemplates As String
    Dim strFileName As String
    Dim strData As String
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim Num As String
    Dim Name As String
    Dim Entity As String
    Dim Chiname As String
    Dim Engname As String

    Dim data_areas As Range
    Dim total_data As Integer
    Dim result As String
    Dim n As Long
    Set data_areas = Application.InputBox(prompt:="Please choose the data", Title:="Data", Type:=8)
    i = data_areas.Row
    j = data_areas.Rows.Count
    over4Names = ""
   
     With Application.FileDialog(msoFileDialogFilePicker)
         .Filters.Add "word", "*.doc*", 1
         .AllowMultiSelect = False
         If .Show Then strTemplates = .SelectedItems(1) Else Exit Sub
    End With
   
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Add "excel", "*.xls*", 1
        .AllowMultiSelect = False
        If .Show Then strData = .SelectedItems(1) Else Exit Sub
   End With
   
    With Application.FileDialog(msoFileDialogFolderPicker)
         Path = ThisWorkbook.Path
    End With
     With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    Set objApp = CreateObject("Word.Application")
    objApp.Visible = False
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open(strData)
    xlApp.Visible = False
    Set xlSheet = xlBook.Worksheets(1)
    nameArray = xlSheet.Range("D1:D" & xlSheet.Cells(Rows.Count, "D").End(xlUp).Row).Value
    For k = i To i + j - 1
      Num = Cells(k, 1)
      Name = Cells(k, 2)
      Entity = Cells(k, 3)
      Chiname = Cells(k, 4)
      Engname = Cells(k, 5)

Set objDoc = objApp.Documents.Open(strTemplates, , False)
strFileName = "Independence Declaration" & "-" & Entity & ".doc"
If Not strFileName Like "*.doc" Then strFileName = strFileName & ".doc"
If Dir(strFileName) <> "" Then Kill strFileName




With objApp.Application.Selection

        .Find.ClearFormatting
        .Find.Replacement.ClearFormatting
        
’下面这段是本来用于替换页眉的代码,思路和替换正文部分的代码一致,但发现替代不了,所以暂时注释掉了
        'ˉWith .Find
         '     .Text = "{$Entity}"
         '     .Replacement.Text = Entity
       '    End With
      '  .Find.Execute Replace:=wdReplaceAll
        
            With .Find
              .Text = "{$Name}"
              .Replacement.Text = Name
           End With
        .Find.Execute Replace:=wdReplaceAll
        
           With .Find
              .Text = "{$Chiname}"
              .Replacement.Text = Chiname
           End With
        .Find.Execute Replace:=wdReplaceAll
        
           With .Find
             .Text = "{$Engname}"
             .Replacement.Text = Engname
           End With
        .Find.Execute Replace:=wdReplaceAll

    End With
    objDoc.SaveAs Path & "\" & strFileName
    objDoc.Saved = True
    Next
    objDoc.Close
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
     result = "Generation Completed"
    MsgBox result, vbYes + vbExclamation
Exit_cmdExportToWord_Click:
    objApp.Quit
    Set objApp = Nothing
    Set objDoc = Nothing
    Set objTable = Nothing
    Set xlApp = Nothing
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Exit Sub
Err_cmdExportToWord_Click:
    MsgBox Err.Description, vbCritical, "Error"
    Resume Exit_cmdExportToWord_Click
End Sub


您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-12-4 01:32 , Processed in 0.048014 second(s), 10 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表