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