文書の最初の単語を選択する方法

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