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

Тема в разделе "Lotus - Программирование", создана пользователем SkyRanger, 8 май 2007.

  1. SkyRanger

    SkyRanger Active Member

    Регистрация:
    17 мар 2007
    Сообщения:
    44
    Симпатии:
    0
    Приветя использую ворд для генерации отчетов. У меня в лотусе используется Rich Text lite и юзверь сам выделяет жирным курсивом и т.д.

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

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

    Код (Text):
       
    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 "Создание отчета завершено"
     
  2. IsAvailable

    IsAvailable Гость

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

    Ctrl+C и Ctrl+V :blink:

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

Поделиться этой страницей