将excel中的文本格式复制到word脚本 [英] Copy text formatting in a excel to word script

问题描述

我有一个功能很好的脚本，它将目标文本从Excel工作表复制到一个打开的Word文档，但我想知道是否可能会复制文本上的格式，这意味着一些文本是粗体并加下划线。目前，它只是将文本复制到单词中。

  Sub Updated_Excel_Data_to_Word（）
 Dim rYes As Range，r As范围
 Dim sData As String 
 Dim tData As String 
 Dim uData As String 
 Dim objWord As Object 
 
 
设置rYes =范围（ B2：B34）
 
 
对于每个r在rYes 
如果r =X然后
 
 sData = sData& r.Offset（0,1）& Chr（13）
结束如果
下一步r 
 
 
设置rYes =范围（F2，范围（F& Rows.Count）.End （xlUp））
 
 
对于每个r在rYes 
如果r =X然后
 
 tData = tData& r.Offset（0,1）& Chr（13）
 End If 
 Next r 
 
 
 
设置rYes = Range（J2，Range（J& Rows）计数）.End（xlUp））
 
 
对于每个r在rYes 
如果r =X然后
 
 uData = uData& r.Offset（0,1）& Chr（13）
 End If 
 Next r 
 
 
 
 
 
设置objWord = GetObject（，word.application ）
 
 objWord.activeDocument.Bookmarks（One）。选择
 objWord.Selection.TypeText（sData）
 objWord.activeDocument.Bookmarks（Two）。 
 objWord.Selection.TypeText（tData）
 objWord.activeDocument.Bookmarks（Three）。选择
 objWord.Selection.TypeText（uData）
 End Sub 
  

解决方案

是的，我认为这应该是可能的，但需要对您的码。您将需要在Word中复制粘贴操作，而不是（正如您目前正在使用）仅将 原始文本存储在 sData ， tData ， uData 变量。

用一个额外的子程序来清理它，因为你在几个不同的范围对象上重复 For Each r loop。

  Sub Updated_Excel_Data_to_Word（）
 
 Dim rYes As Range 
 Dim objWord As Object 
 
'获取Word上的句柄应用程序
设置objWord = GetObject（，word.application）
 
'分配范围
设置rYes =范围（B2：B34）
 
'将范围和Word对象变量传递给助手函数
调用PasteValuesToWordBookmark（rYes，objWord，_ 
 objWord.activeDocument.Bookmarks（One））
 
'根据需要重复，只需更改范围&书签
设置rYes =范围（F2，范围（F& Rows.Count）.End（xlUp））
 
调用PasteValuesToWordBookmark（rYes，objWord，_ 
 objWord.activeDocument.Bookmarks（Two））
 
设置rYes = Range（J2，Range（J& Rows.Count）.End（xlUp））
 
调用PasteValuesToWordBookmark（rYes，objWord，_ 
 objWord.activeDocument.Bookmarks（Three））
 
 End Sub 
 
 Sub PasteValuesToWordBookmark（rng as范围，wdApp作为对象，_ 
 wdBookmark作为对象）
 Dim r as Range 
 
对于每个r在rng 
如果r =X然后
 wdBookmark.Select 
 r.Offset（0，1）.Copy'在我的测试中复制Excel 
'中的单元格会自动添加一个回车符，所以
'我们不需要显式地附加Chr（13）/ vbCR字符
 wdApp.CommandBars.ExecuteMSOPas teSourceFormatting
 End If 
 Next r 
 
 End Sub 
  

这是一个保存所有文本格式（粗体，下划线，字体颜色等）的示例输出。

这应该适用于所有Office应用程序（请参阅 PowerPoint的问答，请从 - ms-word-to-powerpoint-slide / 24641559＃24641559>此处，并提到：

与许多其他方法相比， CommandBars.ExecuteMso 没有很好的记录。 Application.CommandBars 属性参考甚至没有提到 ExecuteMso 方法，我找到了一些有关这方面的信息：

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

I have a functioning script, it copies targeted text from an Excel sheet to an open Word document, but I'm wondering if it's possible that it also copies the formatting on the text, meaning some of the text is Bold and underlined. Currently, it just copies the text over to 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

解决方案

Yes, I think this should be possible but requires some structural changes to your code. You'll need to replicate the "paste" operation in Word, instead of (as you are currently doing) storing only the raw text in your sData, tData, uData variables.

Let's also clean this up with an additional subroutine, since you're repeating the For Each r loop over a few different range objects.

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

Here is some example output which has preserved all of the text formatting (bold, underline, font color, etc.)

This should work across all Office applications (see here for a similar Q&A regarding Excel->PowerPoint), and as mentioned:

The CommandBars.ExecuteMso is not very well-documented compared to many other methods. The Application.CommandBars property reference doesn't even mention the ExecuteMso method, which I found some information about here:

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

This method is useful in cases where there is no object model for a particular command. Works on controls that are built-in buttons, toggleButtons and splitButtons.

You'll need a list of idMso parameters to explore, which come as part of a rather large downloadable file, current for Office 2013 I believe:

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

这篇关于将excel中的文本格式复制到word脚本的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！