将格式化文本从excel复制到单词

我有一个两列string的Excel表。 我使用ms-word跟踪这两列的更改，并将结果复制回第三列。 然后，我将第三列复制到一个新的单词文档。

在单元格C3中的Excel格式是我想转移到单词。

这是我现在得到的。 注意完整的穿透。

为什么它会工作两次，但不是在第三种情况下？

我猜这个问题的根源在于我删除了单词中的CR / Linefeed，以便突破步骤并破坏走向格式的边界。 我的目标是把每个string放在一个单词中。 如果我不删除CR / Linefeed，我会得到四个段落。 背景：在最终的应用程序中，string将成为文本的段落。

excel-vbamacros的源代码（Excel 2010）：技术说明：您可能需要激活excel-vba中的ms-word-objects。 （Microsoft Word 14.0 Object Library）例如，macros假定Range（A1：B3）中存在string

一个string也是一个string
一个string一个新string
一个string没有尝试

结果将被放入范围（C1：C3）。

Option Explicit Dim numberOfBlocks As Long Sub main() Dim i As Long Dim tSht As Worksheet Dim wordapp As Word.Application Dim wdoc As Word.Document Set tSht = ThisWorkbook.ActiveSheet numberOfBlocks = 3 Application.ScreenUpdating = False Set wordapp = CreateObject("Word.Application") For i = 1 To numberOfBlocks Call trackChanges(i, wordapp, tSht) Next i Set wdoc = wordapp.Documents.Add Call copyChanges(tSht, wdoc) End Sub Sub trackChanges(i As Long, wordapp As Word.Application, tSht As Worksheet) Dim diffDoc As Word.Document Dim textString() As Variant Dim j As Long ReDim doc(2) ReDim textString(2) Set textString(1) = tSht.Range("A" & i) Set textString(2) = tSht.Range("B" & i) For j = 1 To 2 With wordapp Set doc(j) = .Documents.Add textString(j).Copy doc(j).Paragraphs(1).Range.PasteSpecial End With Next j wordapp.CompareDocuments OriginalDocument:=doc(1), RevisedDocument:=doc(2), _ Destination:=wdCompareDestinationNew, Granularity:=wdGranularityCharLevel For j = 1 To 2 doc(j).Close SaveChanges:=False Next j Set diffDoc = wordapp.ActiveDocument wordapp.Visible = True 'if the answer has two paragraphs, get both in one paragraph With diffDoc.Content.Find .Forward = True .Wrap = wdFindStop .Format = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True .Text = vbCrLf .Replacement.Text = " " .Execute Replace:=wdReplaceAll End With diffDoc.Range.Copy tSht.Range("C" & i).Select tSht.PasteSpecial Format:="HTML" With tSht.Range("C" & i) .WrapText = True .Font.Name = textString(2).Font.Name .Font.Bold = textString(2).Font.Bold .Font.Size = textString(2).Font.Size .Rows.AutoFit .Interior.Color = textString(2).Interior.Color End With diffDoc.Close SaveChanges:=False Application.CutCopyMode = False Set diffDoc = Nothing End Sub Sub copyChanges(tSht As Worksheet, wdoc As Word.Document) tSht.Range("C1:C" & numberOfBlocks).Copy wdoc.Range(wdoc.Range.End - 1, wdoc.Range.End).PasteSpecial Placement:=wdInLine, DataType:=wdPasteHTML wdoc.Tables(1).ConvertToText Separator:=wdSeparateByParagraphs End Sub