Question

我有一个正常运行的脚本，它将目标文本从Excel工作表复制到打开的Word文档，但我想知道它是否可能复制文本格式，这意味着某些文本大胆并加下划线。目前，它只是将文本复制到单词。

Sub Updated_Excel_Data_to_Word()
    Dim rYes As Range, r As Range
    Dim sData As String
    Dim tData As String
    Dim uData As String
    Dim objWord As Object


    Set rYes = Range("B2:B34")


    For Each r In rYes
        If r = "X" Then

            sData = sData & r.Offset(0, 1) & Chr(13)
        End If
    Next r


     Set rYes = Range("F2", Range("F" & Rows.Count).End(xlUp))


    For Each r In rYes
        If r = "X" Then

            tData = tData & r.Offset(0, 1) & Chr(13)
        End If
    Next r



     Set rYes = Range("J2", Range("J" & Rows.Count).End(xlUp))


    For Each r In rYes
        If r = "X" Then

            uData = uData & r.Offset(0, 1) & Chr(13)
        End If
    Next r





    Set objWord = GetObject(, "word.application")

    objWord.activeDocument.Bookmarks("One").Select
    objWord.Selection.TypeText (sData)
    objWord.activeDocument.Bookmarks("Two").Select
    objWord.Selection.TypeText (tData)
    objWord.activeDocument.Bookmarks("Three").Select
    objWord.Selection.TypeText (uData)
End Sub

Answer 1

是的，我认为这应该是可行的，但需要对代码进行一些结构性更改。您需要复制＆＃34;粘贴＆＃34;在Word中操作，而不是（正如您当前所做的那样）仅在<{1}}，sData，tData变量中存储原始文本。

由于你在几个不同的范围对象上重复uData循环，所以我们还要用一个额外的子程序来清理它。

For Each r

以下是一些示例输出，它保留了所有文本格式（粗体，下划线，字体颜色等）

这适用于所有Office应用程序（有关Excel-＆gt; PowerPoint的类似问答，请参阅here），如上所述：

与许多其他方法相比，Sub Updated_Excel_Data_to_Word() Dim rYes As Range Dim objWord As Object ' Get a handle on Word Application Set objWord = GetObject(, "word.application") ' Assign the range Set rYes = Range("B2:B34") ' Pass the range and Word object variables to the helper function Call PasteValuesToWordBookmark(rYes, objWord, _ objWord.activeDocument.Bookmarks("One")) ' repeat as needed, just changing the range & bookmarks Set rYes = Range("F2", Range("F" & Rows.Count).End(xlUp)) Call PasteValuesToWordBookmark(rYes, objWord, _ objWord.activeDocument.Bookmarks("Two")) Set rYes = Range("J2", Range("J" & Rows.Count).End(xlUp)) Call PasteValuesToWordBookmark(rYes, objWord, _ objWord.activeDocument.Bookmarks("Three")) End Sub Sub PasteValuesToWordBookmark(rng as Range, wdApp as Object, _ wdBookmark as Object) Dim r as Range For Each r In rng If r = "X" Then wdBookmark.Select r.Offset(0, 1).Copy 'Copy the cell from Excel 'in my testing this automatically adds a carriage return, so ' we don't need to explicitly append the Chr(13)/vbCR character wdApp.CommandBars.ExecuteMSO "PasteSourceFormatting" End If Next r End Sub没有很好的记录。 CommandBars.ExecuteMso property reference甚至没有提到Application.CommandBars方法，我在这里找到了一些相关信息：

http://msdn.microsoft.com/en-us/library/office/ff862419(v=office.15).aspx

此方法在特定命令没有对象模型的情况下很有用。适用于内置按钮，toggleButtons和splitButtons的控件。

您需要一个 idMso 参数列表才能进行探索，这些参数作为一个相当大的可下载文件的一部分，是Office 2013的最新信息我相信：

http://www.microsoft.com/en-us/download/details.aspx?id=727

将Excel中的文本格式复制到word脚本

1 个答案: