我想将word文档的内容复制到另一个，将源样式替换为新样式（基于文本解析）。
我正在努力使用该方法添加具有特定文本和样式的新段落。
这是我的功能：
'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
此方法实际上是将文本添加到我的文档中，但样式未正确应用。似乎样式应用于上一段，而不是新创建的。
特别是，行newPar.Range.Text = srcPar.Range.Text有一种奇怪的行为。如果srcPar.Range.Text等于My text，则在调用之后，newPar.Range.Text将保持为空。
我不确定我是否正确使用了范围和段落对象。在此先感谢您的帮助。
仅供参考，以下是我创建新文档的方法：
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
我的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
[编辑] 我尝试了另一种方法：
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
这种方法似乎有效，但有两个缺点：
答案 0 :(得分：1)
经过大量的实验，我终于写了这个函数，它起作用了：
' 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
答案 1 :(得分：1)
在代码进入生产/发行之前，请查看下面的答案。到目前为止提供的所有其他答案中的选择都有一些重要的含义 https://stackoverflow.com/a/51756686/10173250