Insert RTF file into existing document
I have a macro that creates a RTF file based on information in a database in the background and saves it. It formats the text with bold and font size, etc. I format the text with 12 point font size and other parts 10 point. If I open the rtf I created it has all the formatting I told it to use. The problem is that when I insert it into the an existing document it changes the font size to 10 point on all the text in the inserted document. I need it to hold the existing formatting after it is inserted. I have in the Options/Advanced/Cut, Copy and Paste to keep Source formatting but it does not.
Any idea what might be going on?
Here is a portion of the macro..
' open document
Set objDoc = objWord.Documents.Open(StrTempPic)
Set objSelection = objWord.Selection
' if not the first report, double space
If rownum > 1 Then
objSelection.TypeText (vbNewLine & vbNewLine)
End If
objSelection.Font.Bold = True
objSelection.Font.Size = "12"
objSelection.TypeText ("Report Name: ")
' format Report Name
objSelection.Font.Bold = False
objSelection.Font.Size = "10"
objSelection.Font.Underline = True
' Report Name, underlined
'objSelection.TypeText (rs(1) & ", ")
objSelection.TypeText (rs(1)) & ","
' turn off underline
objSelection.Font.Underline = False
' the rest of the line is not underlined, titles will be bold
' Version
objSelection.Font.Bold = True
objSelection.TypeText (" Version: ")
objSelection.Font.Bold = False
objSelection.TypeText (rs(2) & ", ")
'Instance number
objSelection.Font.Bold = True
objSelection.TypeText ("Inst#: ")
objSelection.Font.Bold = False
objSelection.TypeText (rs(3) & vbNewLine & vbNewLine)
objDoc.Save
objDoc.Close
' MsgBox ("Just saved document")
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''
' move to "efrm goes here" section
' it will only be here on the first document insertion
startTag = "\[EmbeddedReport\]"
endTag = "\[/\EmbeddedReport\]"
strSearchString = startTag & "efrm goes here" & endTag
' MsgBox ("SearchString = " & strSearchString)
With Selection.Find
.ClearFormatting
.Text = strSearchString
.Replacement.ClearFormatting
.Replacement.Text = "[EmbeddedReport" & ReportInstance & "]efrm goes here[/EmbeddedReport" & ReportInstance & "]"
' MsgBox Selection.Find.Replacement.Text
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
End With
' end select it
Selection.Find.Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
Selection.HomeKey Unit:=wdStory
With Selection.Find
.ClearFormatting
.Text = "efrm goes here"
.Replacement.ClearFormatting
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
End With
Selection.Find.Execute ' Replace:=wdReplaceAll ' , Forward:=True ' , Wrap:=wdFindContinue
Selection.InsertFile StrTempPic
|