利用VBA拆分Word每个页面并分别保存

最新推荐文章于 2024-08-20 15:58:02 发布

转载最新推荐文章于 2024-08-20 15:58:02 发布 · 827 阅读

1 ·

CC 4.0 BY-SA版权

原文链接：http://www.cnblogs.com/batter152/p/3530711.html

本文介绍如何在Word中使用MailMerge功能批量生成独立的带密码保护的Word文档，并遵循特定的命名规范。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

Word中Mail Merge功能之后，分别保存成独立的word文件

并且添加密码，增加命名规范

Sub BreakOnSection()
Dim a As Excel.Application, ab As Excel.Workbook
Set a = CreateObject("excel.application")
Set ab = a.Workbooks.Open("D:\Book2.xlsx")
  Application.ScreenUpdating = False 'Makes the code run faster and reduces screen flicker a bit.

  ' Used to set criteria for moving through the document by section.
  Application.Browser.Target = wdBrowseSection
  strBaseFilename = ActiveDocument.Name
  On Error GoTo CopyFailed

  'A mail merge document ends with a section break next page.
  For I = 1 To ActiveDocument.Sections.Count

       'Select and copy the section text to the clipboard.
       ActiveDocument.Bookmarks("\Page").Range.Copy

       'Create a new document to paste text from clipboard.
       Documents.Add
       Selection.Paste
       DocNum = DocNum + 1
       With ab
           empId = .Sheets(1).Range("a" & DocNum + 1)
           pwd = .Sheets(1).Range("c" & DocNum + 1)
       End With
           strNewFileName = "xxxx" & empId
           ActiveDocument.SaveAs "D:\" & strNewFileName, Password:=CStr(pwd), WritePassword:="xxxxx", ReadOnlyRecommended:=True
           ActiveDocument.Close
           ' Move the selection to the next section in the document.
           Application.Browser.Next
       Next I
           'Application.Quit SaveChanges:=wdSaveChanges
       End
CopyFailed:
   'MsgBox ("No final Section Break in " & strBaseFilename)
   Application.Quit SaveChanges:=wdSaveChanges
   End
End Sub

转载于:https://www.cnblogs.com/batter152/p/3530711.html