Question

我正在尝试编写一个快速宏，将我的邮件合并文档保存为单独的文档，然后将每个单独的文档保存为每个文档中的第一个单词。

到目前为止，我的目的是剪切文档，并将其保存为“Test_1”等等，但是我在添加代码以选择第一个单词时遇到了问题。

    Sub BreakOnSection()
   'Used to set criteria for moving through the document by section.
   Application.Browser.Target = wdBrowseSection

   'A mailmerge document ends with a section break next page.
   'Subtracting one from the section count stop error message.
   For i = 1 To ((ActiveDocument.Sections.Count) - 1)

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

      'Create a new document to paste text from clipboard.
      Documents.Add
      'To save your document with the original formatting'
      Selection.PasteAndFormat (wdFormatOriginalFormatting)

      'Removes the break that is copied at the end of the section, if any.
      Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
      Selection.Delete Unit:=wdCharacter, Count:=1



      ChangeFileOpenDirectory "H:\Output"
      DocNum = DocNum + 1
      ActiveDocument.SaveAs FileName:="test_" & DocNum & ".doc"
      ActiveDocument.Close
      'Move the selection to the next section in the document
      Application.Browser.Next
   Next i
   ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub

非常感谢任何帮助。

Answer 1

你可以尝试这段代码：

Sub BreakOnSection()
   'Used to set criteria for moving through the document by section.
   Application.Browser.Target = wdBrowseSection

   'A mailmerge document ends with a section break next page.
   'Subtracting one from the section count stop error message.
   For i = 1 To ((ActiveDocument.Sections.Count) - 1)

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

      'Create a new document to paste text from clipboard.
      Documents.Add
      'To save your document with the original formatting'
      Selection.PasteAndFormat (wdFormatOriginalFormatting)

      'Removes the break that is copied at the end of the section, if any.
      Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
      Selection.Delete Unit:=wdCharacter, Count:=1

      'Newly Added
      'GoTo Starting of the Document
      Selection.HomeKey Unit:=wdStory
      Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=True
      Dim FileName As String
      FileName = ReplaceIllegalChar(Trim(Selection.Text))
      'End

      ChangeFileOpenDirectory "H:\Output"
      DocNum = DocNum + 1
      ActiveDocument.SaveAs FileName:="test_" & FileName & ".doc"
      ActiveDocument.Close
      'Move the selection to the next section in the document
      Application.Browser.Next
   Next i
   ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub

Function ReplaceIllegalChar(strIn As String) As String

Dim j As Integer
Dim varStr As String, xStr As String
varStr = strIn
For j = 1 To Len(varStr)
   Select Case Asc(Mid(varStr, j, 1))
        Case 48 To 57, 65 To 90, 97 To 122
        xStr = xStr & Mid(varStr, j, 1)
   Case Else
        xStr = xStr & "_"

   End Select
Next
ReplaceIllegalChar = xStr
End Function

如何选择文档的第一个单词

1 个答案: