1
我想複製一個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
這種方法似乎是工作，但有兩個缺點：
- 它使用印刷紙，可以通過刪除其內容來干擾用戶
- 要花多得多的時間來完成