VBA如何将格式化文本从Excel传递到MS Word

我有一个要求，我需要使用VBA比较Excel中的两个文本样本。因为每个文本样本在LEN中超过3000个字符，所以我使用Userform.TextBox字段获取，将它们存储到字符串变量中

接下来，我使用我在这里找到的“mikerickson”的VBA代码：

比较课文。 问题是该代码的输出被输入到一个单元格：A1。 由于文本示例每个包含3000多个字符，因此结果不会显示在A1中，因为excel对每个单元格的字符数有限制

我想知道如何将结果（所有格式如下划线和删除线）放入MS Word文档

目前，这是用于输出到单元格A1的代码

strResult = ComparedText(strOne, strTwo, olStart, olLength, nwStart, nwLength)

With outCell.Cells(1, 1)
    .Clear
    .Value = strResult
    For i = LBound(olStart) To UBound(olStart)
        If olStart(i) <> 0 Then

            With .Characters(olStart(i), olLength(i)).Font
                .ColorIndex = 3
                .StrikeThrough = True
            End With
        End If
    Next i
    For i = LBound(nwStart) To UBound(nwStart)
        If nwStart(i) <> 0 Then
            With .Characters(nwStart(i), nwLength(i)).Font
                .ColorIndex = 4
                .Underline = True
            End With
        End If
    Next i
End With

strResult=ComparedText（strOne、strTwo、olStart、olLength、nwStart、nwLength）
有outCell.Cells（1，1）
清楚的
.Value=strResult
对于i=LBound（olStart）到UBound（olStart）
如果olStart（i）为0，则
带有.Characters（olStart（i）、olLength（i））.Font
.ColorIndex=3
.StrikeThrough=True
以
如果结束
接下来我
对于i=LBound（nwStart）到UBound（nwStart）
如果nwStart（i）为0，则
带有.Characters（nwStart（i）、nwLength（i））.Font
.ColorIndex=4
.Underline=True
以
如果结束
接下来我
以

此处需要一个替换代码，该代码将在word文档中输入strResult，其格式与上述代码中的格式完全相同

---

希望有人能帮忙。提前谢谢。

这将从A1单元发送到Word。如果单元格A1中的数据被截断，那么我们必须深入挖掘

Set wordy = CreateObject("Word.Application")

wordy.Documents.Add
Sheets(1).Range("A1").Copy
wordy.Documents(1).ActiveWindow.Selection.PasteSpecial DataType:=wdPasteRTF
wordy.Visible = True

'wordy.Quit

Set wordy = Nothing

如果我们可以将strResult插入Word并在其中执行格式化，那么这可能对您有用

Set wordy = CreateObject("Word.Application")

wordy.Documents.Add
wordy.Documents(1).ActiveWindow.Selection.InsertAfter Text:=strResult
wordy.Documents(1).Range.Select
wordy.Visible = True

With wordy.Selection

For i = LBound(olStart) To UBound(olStart)
    If olStart(i) <> 0 Then

        For j = olStart(i) To (olStart(i) + olLength(i) - 1)
            With .Characters(j).Font
                .ColorIndex = 3
                .Strikethrough = True
            End With
        Next j
    End If
Next i

For i = LBound(nwStart) To UBound(nwStart)
    If nwStart(i) <> 0 Then
        For j = nwStart(i) To (nwStart(i) + nwLength(i) - 1)
            With .Characters(j).Font
                .ColorIndex = 4
                .Underline = True
            End With
        Next j
    End If
Next i
End With

Set wordy = Nothing

Set wordy=CreateObject（“Word.Application”）
wordy.Documents.Add
wordy.Documents（1）.ActiveWindow.Selection.InsertAfter Text:=strResult
wordy.Documents（1）.Range.Select
wordy.Visible=True
用罗嗦。选择
对于i=LBound（olStart）到UBound（olStart）
如果olStart（i）为0，则
对于j=olStart（i）至（olStart（i）+olLength（i）-1）
带.Characters（j）.Font
.ColorIndex=3
.Strikethrough=True
以
下一个j
如果结束
接下来我
对于i=LBound（nwStart）到UBound（nwStart）
如果nwStart（i）为0，则
对于j=nwStart（i）至（nwStart（i）+nwLength（i）-1）
带.Characters（j）.Font
.ColorIndex=4
.Underline=True
以
下一个j
如果结束
接下来我
以
设置wordy=Nothing

---

这可能不是最有效的代码，但有望让您朝着正确的方向前进。我不得不创建j循环，因为在Word中，对象一次只能访问一个字符。

感谢您的回复Porcupine911。但是，当有3000个字符时，并不是所有字符都从A1复制到word文档中。因此，需要一种可以直接将strResult复制到Word Doc中的东西.ActiveWindow.Selection.TypeText:=strResult但是我们必须用Word进行格式化。我刚刚用4000个字符做了一个测试，我发布的答案没有问题。即使是这个旧的Excel2003似乎也表明它应该可以正常工作。需要在运行时进行格式化，Porcupine911。这就是要求。有一个要比较的函数，然后格式化结果以突出显示不匹配。所以，如果我不能自动设置格式，那就超过了全部目的。当使用上述代码将输出传递到单元格A1时，格式化工作正常。但是，当strResult被放入Word文档中时，也需要这样做。请帮忙，我不能复制你的问题。我可以将4000个带格式的字符放入单元格A1，然后将其放入Word，格式保持不变。