vba 将文本从一个文档复制到另一个文档的正确方法是什么？

what is the correct way to copy text from one document to another?

提问by Steve B

I want to copy the content of a word document to another, with replacing source styles by new ones (basing on a text parsing).

我想将一个 word 文档的内容复制到另一个，用新的替换源样式（基于文本解析）。

I'm struggling with the method to add a new paragraph with a specific text and style.

我正在努力使用添加具有特定文本和样式的新段落的方法。

Here is my function :

这是我的功能：

'srcPar is the paragraph in the source document
'srcDoc is the document I want to copy
'newDoc is the targetDocument (new document)
'styleName is the name of the style I want to apply
Private Function ImportWithStyle(srcPar As Paragraph, srcDoc As Document, newDoc As Document, styleName As String) As Paragraph
    Dim newPar As Paragraph
    Set newPar = newDoc.Paragraphs.Add()
    newPar.Range.Text = srcPar.Range.Text
    newPar.Range.Style = styleName
    Set ImportWithStyle = newPar
End Function

This method is actually adding the text to my document, but the styles are not applied correctly. It seems the styles is applied to the previous paragraph, and not the newly created.

这种方法实际上是将文本添加到我的文档中，但是样式应用不正确。似乎样式应用于上一段，而不是新创建的。

Especially, the line newPar.Range.Text = srcPar.Range.Texthas a strange behavior. If srcPar.Range.TextequalsMy text, after the call, newPar.Range.Text remains empty.

特别是，该行newPar.Range.Text = srcPar.Range.Text有一个奇怪的行为。如果srcPar.Range.Textequals My text，则在调用后， newPar.Range.Text 保持为空。

I'm not sure that I'm using correctly the ranges and paragraphs objects. Thanks in advance for the help.

我不确定我是否正确使用了范围和段落对象。在此先感谢您的帮助。

FYI, here is how I create the new document :

仅供参考，这是我创建新文档的方法：

Private Sub CreateNewDocumentBasedOn(template As String)
    Dim newDoc As Document
    Dim srcDoc As Document
    Set srcDoc = Application.ActiveDocument
    Set newDoc = Application.Documents.Add("path to a template.dot with common styles")
    newDoc.Range.Delete
    newDoc.AttachedTemplate = template ' path to a specific business template

    Dim srcPar As Paragraph
    Dim previousPar As Paragraph ' keep a track of the last paragraph to help disambiguiting styles

    For Each srcPar In srcDoc.Paragraphs
        Dim newPar As Paragraph
        Set newPar = CopyAndTransformParagraph(srcPar, srcDoc, newDoc, previousPar)
        If newPar.Style <> "CustomStyles_Ignore" Then Set previousPar = newPar
    Next

End Sub

And my CopyAndTransformParagraph function. Its target is to parse text from source to apply the correct style :

还有我的 CopyAndTransformParagraph 函数。它的目标是从源解析文本以应用正确的样式：

Private Function CopyAndTransformParagraph(srcPar As Paragraph, srcDoc As Document, newDoc As Document, previousPar As Paragraph) As Paragraph
    Dim parText As String
    parText = Trim(srcPar.Range.Text)
    ' check all rules for importing a document

    ' Rule : ignore § with no text
    If Match(parText, "^\s*$") Then
        Set CopyAndTransformParagraph = ImportWithStyle(srcPar, srcDoc, newDoc, "CustomStyles_Ignore")

    ' Rule : if § starts with a '-', import as list bulleted
    ElseIf Left(parText, 1) = "-" Then
        Set CopyAndTransformParagraph = ImportWithStyle(srcPar, srcDoc, newDoc, "CustomStyles_ListBulleted")


    ' Rule : if § starts with roman char, import as list roman. Also check if previous paragraph is not a list alpha
    ElseIf Match(parText, "^[ivxlcdm]+\.") Then
        If previousPar Is Nothing Then
              Set CopyAndTransformParagraph = ImportWithStyle(srcPar, srcDoc, newDoc, "CustomStyles_ListRoman")
        ElseIf previousPar.Style = "CustomStyles_ListAlpha" Then 'because romans chars can also be part of an alpha list
              Set CopyAndTransformParagraph = ImportWithStyle(srcPar, srcDoc, newDoc, "CustomStyles_ListAlpha")
        Else
              Set CopyAndTransformParagraph = ImportWithStyle(srcPar, srcDoc, newDoc, "CustomStyles_ListRoman")
        End If


    ' Rule : if § starts with a char, import as list alpha
    ElseIf Match(parText, "^[A-Za-z]+\.") Then
         Set CopyAndTransformParagraph = ImportWithStyle(srcPar, srcDoc, newDoc, "CustomStyles_ListAlpha")

    ' Rule : if § starts with a number, import as list numbered
    ElseIf Match(parText, "^\d+\.") Then
        If previousPar Is Nothing Then
            Set CopyAndTransformParagraph = ImportWithStyle(srcPar, srcDoc, newDoc, "CustomStyles_NormalOutline")
        ElseIf previousPar.Style = "CustomStyles_NormalOutline" And Left(parText, 2) = "1." Then
            Set CopyAndTransformParagraph = ImportWithStyle(srcPar, srcDoc, newDoc, "CustomStyles_ListNumbered")
        Else
            Set CopyAndTransformParagraph = ImportWithStyle(srcPar, srcDoc, newDoc, "CustomStyles_NormalOutline")
        End If

    ' No rule applied
    Else
         Set CopyAndTransformParagraph = ImportWithStyle(srcPar, srcDoc, newDoc, "CustomStyles_Ignore")
    End If

End Function

[Edit]I tried another method :

[编辑]我尝试了另一种方法：

Private Function ImportWithStyle(srcPar As Paragraph, srcDoc As Document, newDoc As Document, styleName As String) As Paragraph

    srcPar.Range.Copy

    Dim r As Range
    Set r = newDoc.Content
    r.Collapse Direction:=WdCollapseDirection.wdCollapseEnd
    r.PasteAndFormat wdFormatSurroundingFormattingWithEmphasis
    r.Style = styleName
    Set ImportWithStyle = newDoc.Paragraphs.Last
End Function

This method seems to work, but have two drawbacks :

这种方法似乎有效，但有两个缺点：

• it uses the press paper and can disturb the user by removing its content
• it takes far more times to complete

• 它使用新闻纸并且可以通过移除其内容来打扰用户
• 需要更多的时间才能完成

采纳答案by Steve B

After a lot of experiments, I finally wrote this function, which is working :

经过大量的实验，我终于写了这个函数，它是有效的：

' Import a paragraph from a document to another, specifying the style
'   srcPar: source paragraph to copy
'   newDoc: document where to import the paragraph
'   styleName: name of the style to apply
'   boldToStyleName (optional): if specified, find bold text in the paragraph, and apply the specified style (of type character style)
'   italicToStyleName (optional): if specified, find italic text in the paragraph, and apply the specified style (of type character style)
'   applyBullet (optional): if true, apply bulleted list to the paragraph before applying the style (to convert list artifacts in the text to word list artifacts)
'   applyOutline (optional): if true, apply outlining to the paragraph before applying the style (to convert list artifacts in the text to word list artifacts)
'   applyRoman (optional): if true, apply roman list to the paragraph before applying the style (to convert list artifacts in the text to word list artifacts)
'   applyAlpha (optional): if true, apply alpha list to the paragraph before applying the style (to convert list artifacts in the text to word list artifacts)
'   applyNumbered (optional): if true, apply numbered list to the paragraph before applying the style (to convert list artifacts in the text to word list artifacts)
'   keepEmphasisParagraphLevel (optional): if true (default), preserve bold and italic at character level and paragraph level
Public Function ImportWithStyle( _
    srcPar As Paragraph, _
    newDoc As Document, _
    styleName As String, _
    Optional boldToStyleName As String, _
    Optional italicToStyleName As String, _
    Optional applyBullet As Boolean = False, _
    Optional applyOutline As Boolean = False, _
    Optional applyRoman As Boolean = False, _
    Optional applyAlpha As Boolean = False, _
    Optional applyNumbered As Boolean = False, _
    Optional keepEmphasisParagraphLevel As Boolean = True _
    ) As Paragraph
    Dim newPar As Paragraph
    Dim r As Range
    Dim styleToApply As style
    Set styleToApply = newDoc.Styles(styleName) ' find the style to apply. The style must exists

    ' get the end of the document range
    Set r = newDoc.Content
    r.Collapse direction:=WdCollapseDirection.wdCollapseEnd

    ' inject the formatted text from the source paragraph
    r.FormattedText = srcPar.Range.FormattedText


    ' apply list template from the target style.

    If applyBullet Then
        r.ListFormat.ApplyBulletDefault
    ElseIf applyNumbered Or applyRoman Or applyAlpha Then  ' Roman is a kind of numbering
        r.ListFormat.ApplyNumberDefault
    ElseIf applyOutline Then
        r.ListFormat.ApplyOutlineNumberDefault
    End If


    ' apply yhe style
    r.style = styleToApply
    Set newPar = newDoc.Paragraphs(newDoc.Paragraphs.Count - 1)


    ' replace bold text format by a character style
    If boldToStyleName <> "" Then
        With newPar.Range.Find
            .ClearFormatting
            .Font.Bold = True
            .Format = True
            With .replacement
                .ClearFormatting
                .style = newDoc.Styles(boldToStyleName)
            End With
            .Execute Replace:=wdReplaceAll
        End With
    End If
    ' replace italic text format by a character style
    If italicToStyleName <> "" Then
        With newPar.Range.Find
            .ClearFormatting
            .Font.Italic = True
            .Format = True
            With .replacement
                .ClearFormatting
                .style = newDoc.Styles(italicToStyleName)
            End With
            .Execute Replace:=wdReplaceAll
        End With
    End If
    With srcPar.Range
        ' If only part of the text is bold, Bold property is wdUndefined. In this case we don't apply bold
        If keepEmphasisParagraphLevel And .Bold <> wdUndefined And .Bold = True Then newPar.Range.Bold = True
        ' same for italic
        If keepEmphasisParagraphLevel And .Italic <> wdUndefined And .Italic Then newPar.Range.Italic = True
    End With
    ' returns the newly created paragraph
    Set ImportWithStyle = newPar
End Function

回答by Fr4nc01s

Please take a look at the answer below before your code goes to production/distribution. There are some important implications to the choices made in all other answers provided so far https://stackoverflow.com/a/51756686/10173250

在您的代码进入生产/分发之前，请查看下面的答案。到目前为止提供的所有其他答案中的选择都有一些重要的影响 https://stackoverflow.com/a/51756686/10173250