Передача оформления Rtf в Word

[SkyRanger]

Приветя использую ворд для генерации отчетов. У меня в лотусе используется Rich Text lite и юзверь сам выделяет жирным курсивом и т.д.

Проблема в том, что все работает нормально, кроме того, что передается только текст, оформление (жирныйб курсив и т.д.) теряется

Как мне в ворд передать текст как он есть???

Dim WS As New NotesUIWorkspace	
Set session = New NotesSession
Set db=session.CurrentDatabase
Dim fd As NotesDocumentCollection


Set uidoc = ws.CurrentDocument


formul = {SELECT form="pregcard" & date_priem =[} & uidoc.FieldGetText("date1")&{]}

Set v=db.GetView("rep_reestr2")


v.SelectionFormula = formul
Call v.Refresh

Set tst=v.GetFirstDocument

If tst Is Nothing Then 
answ = Messagebox("Нет данных за данный период!" , MB_OK+MB_ICONINFORMATION,"Нет данных")
Exit Sub 
End If

Print "Идет создание отчета. Пожалуйста подождите..."


Set word = CreateObject("Word.Application") 'Создание объекта Word'a
Call word.documents.add("c:\lotus\rep_reestr_1.dot") 'Создание нового документа по шаблону 
Set worddoc = word.activedocument 'Активация объекта

word.visible = True 'Сделать видимым окно Word'a

'Call worddoc.Tables.Add(worddoc.Tables(1).Rows(5).Range,1,6,1,0)
'Call worddoc.Tables(1).Rows(5).Select
'Call word.Selection.InsertRowsBelow(1)
'Call word.Selection.TypeText("1111111111")
'Call word.Selection.MoveRight(12) 'на ячейку вправо
'Call word.Selection.TypeText("222222")
'Call worddoc.Tables.Add(worddoc.Paragraphs(3).Range,2,3,1,0)

row=6

Set docX=v.GetFirstDocument
While Not docX Is Nothing

rowcount=0

If Trim(docX.ColumnValues(2))<>"" Then
rowcount=rowcount+1	
End If
If Trim(docX.ColumnValues(3))<>"" Then
rowcount=rowcount+1	
End If
If Trim(docX.ColumnValues(4))<>"" Then
rowcount=rowcount+1	
End If

Call worddoc.Tables(1).Rows(3).Select
Call word.Selection.TypeText(uidoc.FieldGetText("date1"))


Call worddoc.Tables(1).Rows(row-1).Select
Call word.Selection.InsertRowsBelow(1)
Call word.Selection.TypeText(Str(Row-5))

Call word.Selection.MoveRight(12) 'step right

cValue = docX.ColumnValues(0)
If Trim(cValue)<>"" Then
cValue=Replace(cValue,Chr(13)," ")
End If

Call word.Selection.TypeText(cValue)

Call word.Selection.MoveRight(12) 'step right


cValue = Replace(docX.ColumnValues(1),Chr(10)," ") + Chr(10) + " --- " + Chr(10)+ Replace(docX.ColumnValues(2),Chr(10)," ")
If Trim(docX.ColumnValues(3))<>"" Then
cValue = cValue +Chr(10)+Replace(docX.ColumnValues(3),Chr(10)," ")
End If

Dim rtitem As Variant
Set rtitem = docX.GetFirstItem( "extra_info" )

If Trim(rtitem.Values<>"") Then
cValue = cValue +Chr(10)+"---"+Chr(10)+rtitem.Values
End If

If Trim(cValue)<>"" Then
cValue=Replace(cValue,Chr(13)," ")
End If

Call word.Selection.TypeText(cValue)

Call word.Selection.MoveRight(12) 'step right

Set rtitem = docX.GetFirstItem( "galob_txt" )

Call word.Selection.TypeText(rtitem.Values)

Call word.Selection.MoveRight(12) 'step right

cValue = docX.ColumnValues(6)		
Set rtitem = docX.GetFirstItem( "resolut")

Call word.Selection.TypeText(cValue+Chr(10)+"---"+Chr(10)+rtitem.Values)



Call word.Selection.MoveRight(12) 'step right


Set rtitem = docX.GetFirstItem( "dop_memo" )

Call word.Selection.TypeText(rtitem.Values)

col=1
row=row+1+row1
Set docX=v.GetNextDocument(docX)
Wend



Print "Создание отчета завершено"

 

[IsAvailable]

Ну видать TypeText печатает просто текст без форматирования. Форматирование нужно устанавливать предварительно...
Самое первое, что приходит в ум предложить - попробовать сработать через буфер обмена : )

Ctrl+C и Ctrl+V :blink:

Ну соответственно Copy из итэма и Paste в Ворд... Сам не пробовал, но вдруг прокатит.