Создание таблицы в RT-поле с помощью NotesRichTextTable

Тема в разделе "Lotus - Программирование", создана пользователем StarikStarik2705, 24 окт 2012.

  1. StarikStarik2705

    StarikStarik2705 Well-Known Member

    Регистрация:
    8 фев 2012
    Сообщения:
    103
    Симпатии:
    0
    в общем не писал бы сюда если бы знал как это делать.

    задача такая, нарисовал таблицу:
    Код (LotusScript):
            REM Create a table
    Dim rti As New NotesRichTextItem(Me.doc_, "RT_History")
    Call rti.AppendText("Табличка")
    Call rti.AddNewLine(2)
    Dim rows As Integer, columns As Integer, a As Integer, b As Integer
    rows = 1
    columns= 5
    Call rti.AppendTable(rows, columns)
    REM Create a table
    и теперь хочу в первые пять столбиков в ячейки таблицы что-то забить программно. как это сделать?

    На форумах нашёл такой
    <div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">код</div></div><div class="sp-body"><div class="sp-content">
    Код (LotusScript):
            Dim rtnav As NotesRichTextNavigator
    REM Find first table in Body item
    Set rtnav = rti.CreateNavigator
    If Not rtnav.FindFirstElement(RTELEM_TYPE_TABLE) Then
    MessageBox "Body item does not contain a table,",, _
    "Error"
    Exit Sub
    End If
    REM Set up range and navigator for table
    Dim rtRangeTable As NotesRichTextRange
    Set rtRangeTable = rti.CreateRange
    Call rtRangeTable.SetBegin(rtnav)
    Call rtRangeTable.SetEnd(rtnav)
    Dim rtNavTable As NotesRichTextNavigator
    Set rtNavTable = rtRangeTable.Navigator
    REM Find cells in table
    Dim rtRangeCell As NotesRichTextRange
    Dim rtRangePara As NotesRichTextRange  
    Set rtRangeCell = rti.CreateRange
    Set rtRangePara = rti.CreateRange

    Dim cellCounter As Long
    cellCounter = 0
    Call rtNavTable.FindFirstElement(RTELEM_TYPE_TABLECELL)
    Call    rti.Update
    Dim rtpStyle As NotesRichTextParagraphStyle
    Do         
    Call rti.BeginInsert( rtNavTable )
    Call rti.AppendParagraphStyle(rtpStyle)
    Call rti.AppendText("Дописываем какойто текст")
    Call rti.EndInsert
    'msg= ""
    cellCounter = cellCounter + 5

    REM Set up range and navigator for cell
    Call rtRangeCell.SetBegin(rtNavTable)
    Call rtRangeCell.SetEnd(rtNavTable)
    Dim rtNavCell As NotesRichTextNavigator
    Set rtNavCell = rtRangeCell.Navigator

    Loop While rtNavTable.FindNextElement(RTELEM_TYPE_TABLECELL)
    который в первые две ячейки пишет "Дописываем какой-то текст", но мне бы хотелось почётче, другой вопрос, что сам разбираться буду очень долго, если кто может объясните как пользоваться этими методами.
     
  2. NickProstoNick

    NickProstoNick Статус как статус :)

    Регистрация:
    22 авг 2008
    Сообщения:
    1.766
    Симпатии:
    39
    Тю... ну так в чем вопрос?
    Берешь этот код, тестируешь его в отладчике и разбираешься как это работает. :mellow:
     
  3. VladSh

    VladSh начинающий
    Lotus team

    Регистрация:
    11 дек 2009
    Сообщения:
    1.251
    Симпатии:
    2
    Класс NotesRichTextTable, см. пример. Но для установленных законом форм пользоваться не советую, т.к. нет возможности жёсткой установки размеров колонок и строк.
     
  4. lmike

    lmike нет, пердело совершенство
    Команда форума Lotus team

    Регистрация:
    27 авг 2008
    Сообщения:
    6.081
    Симпатии:
    300
  5. StarikStarik2705

    StarikStarik2705 Well-Known Member

    Регистрация:
    8 фев 2012
    Сообщения:
    103
    Симпатии:
    0
    Протестировал и в общем выход нашёл, спасибо но теперь гомно в другом.
    <div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">код</div></div><div class="sp-body"><div class="sp-content">
    Код (LotusScript):
            Set RTItem = New NotesRichTextItem(doc, \"RT_History\")
    Let RTItem.SaveToDisk = False
    Set Black = s.CreateRichTextStyle
    Let Black.NotesColor = COLOR_BLACK
    Set Green = s.CreateRichTextStyle
    Let Green.NotesColor = COLOR_DARK_GREEN
    Set Blue = s.CreateRichTextStyle
    Let Blue.NotesColor = COLOR_DARK_BLUE
    Set Bold = s.CreateRichTextStyle
    Let Bold.Bold = True
    Let Bold.FontSize = 8
    Set Regular = s.CreateRichTextStyle
    Let Regular.Bold = False
    Let Regular.FontSize = 8


    Dim flag As Boolean \' что бы один раз заголовок в цикле нарисовать
    Dim DataTime As NotesItem
    flag = false

    Set Styles(\"Header\") = New MyNotesCellHeaderStyle
    Set Styles(\"Data\") = New MyNotesCellDataStyle
    Set Styles(\"Red\") = New MyNotesCellRedStyle
    Set Styles(\"Green\") = New MyNotesCellGreenStyle
    Set Styles(\"Gray\") = New MyNotesCellGrayStyle
    Set Styles(\"Link\") = New MyNotesCellLinkStyle

    CurentRow = 1
    Dim XTable1 As XTable

    \'  If XTable.rowCount > 1 Then
    \'      CurentRow = XTable.rowCount + 1
    \'  Else
    \'      CurentRow = 1
    \'  End If

    Set XTable = New XNotesTable(CurentRow, 5)
    ForAll x In fieldsListContent
    If  Not equal(x,(fieldsListSaveChange(ListTag(x)))) then   
    Set DataTime = doc.Getfirstitem(ListTag(x))        
    \'определим сколько строк в таблице будет  
    CurentRow = CurentRow + 1
    If CurentRow > 1 Then      
    Dim tableStyle As New MyNotesTableStyle(7)
    Set XTable.Style = tableStyle                      
    If Not flag Then
    XTable.row(1).column(1).value = \"Дата и время изменения\"
    XTable.row(1).column(2).value = \"Изменено поле\"
    XTable.row(1).column(3).value = \"Старое значение\"
    XTable.row(1).column(4).value = \"Новое значение\"
    XTable.row(1).column(5).value = \"Автор изменения\"
    Set XTable.row(1).style = Styles(\"Header\")
    flag = true
    End If 
    XTable.row(CurentRow).column(1).value = DataTime.Lastmodified
    XTable.row(CurentRow).column(2).value = DataTime.Name
    XTable.row(CurentRow).column(3).value = x(0)
    XTable.row(CurentRow).column(4).value = Join(fieldsListSaveChange(ListTag(x)))
    XTable.row(CurentRow).column(5).value = s.Effectiveusername
    Set XTable.row(CurentRow).style = Styles(\"Data\")
    End If
    End If
    end ForAll



    If CurentRow > 1 Then      
    Call XTable.InsertToRTItem(RTItem)     
    End If


    код рисует, таблицу, пять колонок, ну и то что мне надо, но сохранив док, закрыв его, и потом снова открыв увидел таблицу. почему не возможно проверить потом в РТ поле что там есть таблица или нет?
    Dim rti As NotesRichTextItem
    Set rti = doc.GetFirstItem(\"RT_History\")
    Dim rtnav As NotesRichTextNavigator
    Set rtnav = rti.CreateNavigator
    If Not rtnav.FindFirstElement(RTELEM_TYPE_TABLE) Then
    Messagebox \"Body item does not contain a table,\",, \"Error\"
    Exit Sub
    End If
    выдаёт упорно ошибку что таблицы там нет
    что посоветуете?
     
  6. savl

    savl Lotus team
    Lotus team

    Регистрация:
    28 окт 2011
    Сообщения:
    2.052
    Симпатии:
    146
    Это не баг, а фича. Так оно и работает. RT поля не существует до сохранения документа, только после.
     
  7. StarikStarik2705

    StarikStarik2705 Well-Known Member

    Регистрация:
    8 фев 2012
    Сообщения:
    103
    Симпатии:
    0
    шутка была в том что, я его сохранил, переоткрыл, а таблицу не видит хоть ты ....в общем проблему решил
    <div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">"код"</div></div><div class="sp-body"><div class="sp-content">
    Код (LotusScript):
    On Error GoTo errorProc1

    Dim i As Long


    Set Me.s=New NotesSession()
    Set Me.db=Me.s.Currentdatabase
    Set Me.doc_=doc    
    If Trim(ListF)="" Then
    ReDim ME.fieldsNameList_(0)
    Me.fieldsNameList_(0)=""
    Else
    Me.fieldsNameList_=Split(ListF,";")        
    End If
    If (Me.fieldsNameList_(0))<>"" Then
    For i=LBound(Me.fieldsNameList_) To UBound(Me.fieldsNameList_)
    fieldsListSaveChange(Me.fieldsNameList_(i))=Me.doc_.Getitemvalue(Me.fieldsNameLi
    st_(i))
    Next
    End If 

    Dim tableStyle As New MyNotesTableStyle(7)

    If doc.Getfirstitem("RT_History") Is Nothing Then
    Set RTItem = new NotesRichTextItem(doc, "RT_History")
    Let RTItem.SaveToDisk = False
    Else
    Set RTItem = doc.Getfirstitem("RT_History")
    End If

    Set Black = s.CreateRichTextStyle
    Let Black.NotesColor = COLOR_BLACK
    Set Green = s.CreateRichTextStyle
    Let Green.NotesColor = COLOR_DARK_GREEN
    Set Blue = s.CreateRichTextStyle
    Let Blue.NotesColor = COLOR_DARK_BLUE
    Set Bold = s.CreateRichTextStyle
    Let Bold.Bold = True
    Let Bold.FontSize = 8
    Set Regular = s.CreateRichTextStyle
    Let Regular.Bold = False
    Let Regular.FontSize = 8


    Dim flag As Boolean ' что бы один раз заголовок в цикле нарисовать
    Dim DataTime As NotesItem

    flag = false

    Set Styles("Header") = New MyNotesCellHeaderStyle
    Set Styles("Data") = New MyNotesCellDataStyle
    Set Styles("Red") = New MyNotesCellRedStyle
    Set Styles("Green") = New MyNotesCellGreenStyle
    Set Styles("Gray") = New MyNotesCellGrayStyle
    Set Styles("Link") = New MyNotesCellLinkStyle

    CurentRow = 1

    Set XTable = New XNotesTable(CurentRow, 5)
    ForAll x In fieldsListContent
    If  Not equal(x,(fieldsListSaveChange(ListTag(x)))) then   
    Set DataTime = doc.Getfirstitem(ListTag(x))        
    'определим сколько строк в таблице будет   
    CurentRow = CurentRow + 1
    If CurentRow > 1 Then      
    'Dim tableStyle As New MyNotesTableStyle(7)
    Set XTable.Style = tableStyle                      
    If Not flag Then
    XTable.row(1).column(1).value = "Дата и время изменения"
    XTable.row(1).column(2).value = "Изменено поле"
    XTable.row(1).column(3).value = "Старое значение"
    XTable.row(1).column(4).value = "Новое значение"
    XTable.row(1).column(5).value = "Автор изменения"
    Set XTable.row(1).style = Styles("Header")
    flag = true
    End If 
    XTable.row(CurentRow).column(1).value = DataTime.Lastmodified
    XTable.row(CurentRow).column(2).value = DataTime.Name
    XTable.row(CurentRow).column(3).value = x(0)
    XTable.row(CurentRow).column(4).value = Join(fieldsListSaveChange(ListTag(x)))
    XTable.row(CurentRow).column(5).value = s.Effectiveusername
    Set XTable.row(CurentRow).style = Styles("Data")
    End If
    End If
    end ForAll

    If CurentRow > 1 Then      
    Call XTable.InsertToRTItem(RTItem)     
    End If


    Call doc.Save( True, False )   

    endofsub:
    Exit Sub
    errorproc1:
    MsgBox "Error #" & Err & " on line " & Erl & " in SL HistoryChangeData --> Class HistoryChange --> " & LSI_Info(2) & " : " & Error, 48, "Runtime error"
    Resume endofsub
    думаю может кому и пригодиться
    спасибо вам
     
  8. VladSh

    VladSh начинающий
    Lotus team

    Регистрация:
    11 дек 2009
    Сообщения:
    1.251
    Симпатии:
    2
    Если бы ещё и классы, начинающиеся с MyNotes_, то возможно и пригодилось бы :mellow:
     
  9. StarikStarik2705

    StarikStarik2705 Well-Known Member

    Регистрация:
    8 фев 2012
    Сообщения:
    103
    Симпатии:
    0
    <div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">"код"</div></div><div class="sp-body"><div class="sp-content">
    Код (LotusScript):
    Option Declare
    Option Public

    Private FAIL_ON_NONE_EXISTING_CELL As Boolean
    Public Class X_Table
    Private style_ As XStyle


    Public Property Set Style As XStyle
    Set me.style_ = Style
    End Property

    Public Property Get Style As XStyle
    Set Style = me.style_
    End Property
    End Class
    Public Class XCell As X_Table

    Private value_ As Variant
    Private type_ As String
    %REM
    Property Set Value
    Description: Comments for Property Set
    %END REM

    Public Property Set Value
    me.value_ = Value
    End Property

    Public Property Get Value
    Value = me.value_
    End Property

    Public Property Set cellType As String
    me.type_ = cellType
    End Property

    Public Property Get cellType As String
    cellType = me.Type_
    End Property

    Public Property Get StrValue As String
    StrValue = CStr(me.value_)
    End Property

    End Class
    %REM
    Class XRow
    Description: Comments for Class
    %END REM

    Public Class XRow As X_Table

    Private cells_ List As XCell
    Private columnCount_ As Integer

    Public Sub New(column As Integer)
    Dim i As Integer
    For i = 1 To column
    Set me.cells_(CStr(i)) = New XCell()
    Next
    columnCount_ = column
    End Sub

    Public Function column(colnumber As Integer) As XCell
    If columnCount_< colnumber Then
    If FAIL_ON_NONE_EXISTING_CELL Then
    Error 1002, "XRow: Несуществующая ячейка"
    Else
    'TODO: Обработка добавления Столбцов
    End If
    End If
    If IsElement(cells_(CStr(colnumber))) Then
    Set column = cells_(CStr(colnumber))
    End If
    End Function

    Public Function SetColumn(colnumber As Integer, Cell As XCell) As XCell
    If columnCount_< colnumber Then
    If FAIL_ON_NONE_EXISTING_CELL Then
    Error 1002, "XRow: Несуществующая ячейка"
    Else
    'TODO: Обработка добавления Столбцов
    End If
    End If
    If IsElement(cells_(CStr(colnumber))) Then
    Set cells_(CStr(colnumber)) = Cell
    Set SetColumn = Cell
    End If
    End Function

    %REM
    Function SetRowValues
    Description: Comments for Function
    %END REM

    Public Property Set Values
    Dim tmp As Variant
    tmp = Values
    If Not(IsArray(tmp)) Then
    Error 1002, "XRow, Values: ожидается массив"
    End If

    Dim i As Integer

    If UBound(tmp) + 1 > columnCount_ Then
    If FAIL_ON_NONE_EXISTING_CELL Then
    Error 1002, "XRow: Несуществующая ячейка"
    Else
    'TODO: Обработка добавления Столбцов
    End If
    End If

    For i = LBound(tmp) + 1 To UBound(tmp) + 1
    me.cells_(i).Value = tmp(i - 1)
    Next       
    End Property

    End Class

    %REM
    Class XColor
    Description: Comments for Class
    %END REM

    Public Class XStyle
    %REM
    Sub Apply
    Description: Comments for Sub
    %END REM

    Public Function Apply(inParam As Variant) As Variant

    End Function
    End Class
    %REM
    Class XTable
    Description: Comments for Class
    %END REM

    Public Class XTable As X_Table

    Private rows_ List As XRow
    Private rowCount_ As Integer
    Private columnCount_ As Integer

    %REM
    Sub New
    Description: Comments for Sub
    %END REM

    Public Sub New(rows As Integer, column As Integer)
    Dim i As Integer
    For i = 1 To rows
    Set me.rows_(CStr(i)) = New XRow(column)
    Next       
    me.rowCount_ = rows
    me.columnCount_ = column
    End Sub

    %REM
    Function row
    Description: Comments for Function
    %END REM

    Public Function row(rownumber As Integer) As XRow
    If rowCount_< rownumber Then
    If FAIL_ON_NONE_EXISTING_CELL Then
    Error 1001, "Несуществующая строка"
    Else
    Call addRow(rownumber)
    End If
    End If
    If IsElement(rows_(CStr(rownumber))) Then
    Set row = rows_(CStr(rownumber))
    End If
    End Function

    %REM
    Property Get rowCount_
    Description: Comments for Property Get
    %END REM

    Public Property Get rowCount As Integer
    rowCount = rowCount_
    End Property


    %REM
    Property Get columnCount
    Description: Comments for Property Get
    %END REM

    Public Property Get columnCount As Integer
    columnCount = columnCount_
    End Property

    %REM
    Sub addRow
    Description: Comments for Sub
    %END REM

    Private Sub addRow(rownumber As Integer)
    Dim i As Integer
    For i = rowCount_ + 1 To rownumber
    Set me.rows_(CStr(i)) = New XRow(columnCount_)
    Next       
    me.rowCount_ = rownumber
    End Sub
    End Class

    %REM
    Class XNotesTable
    Description: Comments for Class
    %END REM

    Public Class XNotesTable As XTable


    %REM
    Sub New
    Description: Comments for Sub
    %END REM


    Public Sub New(rows As Integer, column As Integer)

    End Sub

    %REM
    Sub InsertToRTItem
    Description: Comments for Sub
    %END REM

    Public Sub InsertToRTItem(rtitem As NotesRichTextItem)



    'Добавляем
    If me.Style Is Nothing Then
    Call rtitem.AppendTable( me.rowCount, me.columnCount,)
    Else
    Call rtitem.AppendTable( me.rowCount, me.columnCount,,,me.Style.Apply(Nothing) )
    Call rtitem.Appendtext("11111111")
    End If


    Dim rtNav As NotesRichTextNavigator
    Set rtNav = rtitem.CreateNavigator

    Call rtNav.GetFirstElement(RTELEM_TYPE_TABLE)

    Dim rtTable As NotesRichTextTable
    Set rtTable= rtNav.GetElement

    Call me.Style.Apply(rtTable)

    Call rtNav.FindFirstElement(RTELEM_TYPE_TABLECELL)

    Dim i As Integer, j As Integer

    For i = 1 To me.rowCount
    For j = 1 To me.columnCount
    Call rtitem.BeginInsert( rtNav )               
    If Not me.row(i).Style Is Nothing Then
    Call rtitem.Appendstyle(me.row(i).Style.Apply(rtitem))
    End If                             
    If Not me.row(i).column(j).Style Is Nothing Then
    Call rtitem.Appendstyle(me.row(i).column(j).Style.Apply(rtitem))
    End If         

    If me.row(i).column(j).cellType = "Link" Then
    Dim tmp As Variant
    Set tmp = me.row(i).column(j)
    Call rtitem.AppendText( StrLeft(me.row(i).column(j).StrValue,"%Link%"))
    Call rtitem.Appenddoclink(tmp.LinkDoc, "")
    Call rtitem.AppendText( StrRight(me.row(i).column(j).StrValue,"%Link%") )
    Else
    Call rtitem.AppendText( me.row(i).column(j).StrValue )
    End If             
    Call rtitem.EndInsert                                              
    Call rtNav.FindNextElement( RTELEM_TYPE_TABLECELL )                    
    Next
    Next

    End Sub
    End Class
    Class MyNotesTableStyle As XStyle

    Private colCount_ As Integer
    Private s As NotesSession

    Sub New (colCount As Integer)
    colCount_ = colCount
    Set Me.s = New NotesSession
    End Sub

    Function Apply(inParam As Variant) As Variant

    If inParam Is Nothing Then
    Dim tableColStyles() As Variant
    ReDim tableColStyles(1 To colCount_)

    Dim i As Integer
    For i = 1 To colCount_

    Set tableColStyles(i) = s.CreateRichTextParagraphStyle
    tableColStyles(i).FirstLineLeftMargin = RULER_ONE_CENTIMETER *0.1
    tableColStyles(i).LeftMargin = RULER_ONE_CENTIMETER *0.1

    Select Case i
    Case 1
    tableColStyles(i).RightMargin = RULER_ONE_CENTIMETER * 4
    Case 2
    tableColStyles(i).RightMargin = RULER_ONE_CENTIMETER * 4
    Case 3
    tableColStyles(i).RightMargin = RULER_ONE_CENTIMETER * 5                   
    Case 4
    tableColStyles(i).RightMargin = RULER_ONE_CENTIMETER * 6
    Case 5
    tableColStyles(i).RightMargin = RULER_ONE_CENTIMETER * 6.8
    Case Else
    tableColStyles(i).RightMargin = RULER_ONE_CENTIMETER * 2.2
    End Select
    Next
    Apply = tableColStyles
    Else
    Dim w As New NotesUIWorkspace
    Dim doc As NotesDocument
    Set doc = w.Currentdocument.Document

    Dim rtTable As NotesRichTextTable
    Set rtTable = inParam
    rtTable.Style = TABLESTYLE_TOP
    Dim color As NotesColorObject
    Set color = s.CreateColorObject

    If doc.Getitemvalue("FlagForRTitem")(0) = "1" Then
    color.NotesColor = color.Setrgb(255,255,255) 'если в первый столбец(шапка) нарисован, но все остальные таблицы с первого рядка должны быть в нейтральном цвете
    Else
    color.NotesColor = color.Setrgb(220,220,220)   
    End If     
    Call rtTable.SetColor( color )
    color.NotesColor = COLOR_WHITE
    Call rtTable.SetAlternateColor( color )

    End If
    End Function
    End Class
    ' Стиль ячеек заголовка
    Class MyNotesCellHeaderStyle As XStyle

    Private s As NotesSession

    Sub New ()
    Set Me.s = New NotesSession
    End Sub

    Function Apply(inParam As Variant) As Variant

    Dim rtItem As NotesRichTextItem
    Set rtItem = inParam

    Dim nrts As NotesRichTextStyle
    Set nrts = s.Createrichtextstyle()

    nrts.Fontsize = 8
    nrts.Bold = True
    nrts.Notesfont = rtItem.Getnotesfont("Verdana", True)

    nrts.PassThruHTML = False

    Set Apply = nrts
    End Function

    End Class
    ' Стиль ячеек просроченного поручения
    Class MyNotesCellRedStyle As XStyle

    Private s As NotesSession

    Sub New ()
    Set Me.s = New NotesSession
    End Sub

    Function Apply(inParam As Variant) As Variant

    Dim rtItem As NotesRichTextItem
    Set rtItem = inParam

    Dim nrts As NotesRichTextStyle
    Set nrts = s.Createrichtextstyle()

    nrts.Fontsize = 8
    nrts.Bold = False
    nrts.Notesfont = rtItem.Getnotesfont("Verdana", True)
    nrts.Underline = False

    Dim color As NotesColorObject
    Set color = s.CreateColorObject
    nrts.NotesColor = color.SetRGB(255, 0, 0)

    nrts.PassThruHTML = False

    Set Apply = nrts
    End Function

    End Class
    ' Стиль ячеек исполненного поручения
    Class MyNotesCellGreenStyle As XStyle
    Private s As NotesSession

    Sub New ()
    Set Me.s = New NotesSession
    End Sub

    Function Apply(inParam As Variant) As Variant

    Dim rtItem As NotesRichTextItem
    Set rtItem = inParam

    Dim nrts As NotesRichTextStyle
    Set nrts = s.Createrichtextstyle()

    nrts.Fontsize = 8
    nrts.Bold = False
    nrts.Notesfont = rtItem.Getnotesfont("Verdana", True)
    nrts.Underline = False

    Dim color As NotesColorObject
    Set color = s.CreateColorObject
    nrts.NotesColor = color.SetRGB(0, 128, 0)

    nrts.PassThruHTML = False

    Set Apply = nrts
    End Function
    End Class

    ' Стиль ячеек дочернего поручения
    Class MyNotesCellGrayStyle As XStyle
    Private s As NotesSession

    Sub New ()
    Set Me.s = New NotesSession
    End Sub

    Function Apply(inParam As Variant) As Variant

    Dim rtItem As NotesRichTextItem
    Set rtItem = inParam

    Dim nrts As NotesRichTextStyle
    Set nrts = s.Createrichtextstyle()

    nrts.Fontsize = 8
    nrts.Bold = True
    nrts.Notesfont = rtItem.Getnotesfont("Verdana", True)
    nrts.Underline = False

    Dim color As NotesColorObject
    Set color = s.CreateColorObject
    nrts.NotesColor = color.SetRGB(128, 128, 128)

    nrts.PassThruHTML = False

    Set Apply = nrts
    End Function

    End Class

    ' Стиль ячеек таблицы
    Class MyNotesCellDataStyle As XStyle
    Private s As NotesSession

    Sub New ()
    Set Me.s = New NotesSession
    End Sub
    Function Apply(inParam As Variant) As Variant

    Dim rtItem As NotesRichTextItem
    Set rtItem = inParam


    Dim nrts As NotesRichTextStyle
    Set nrts = s.Createrichtextstyle()

    nrts.Fontsize = 8
    nrts.Bold = False
    nrts.Notesfont = rtItem.Getnotesfont("Verdana", True)
    nrts.Underline = False

    Dim color As NotesColorObject
    Set color = s.CreateColorObject
    nrts.NotesColor = color.SetRGB(0, 0, 0)

    nrts.PassThruHTML = False

    Set Apply = nrts
    End Function

    End Class

    ' Стиль ячеек таблицы
    Class MyNotesCellLinkStyle As XStyle
    Private s As NotesSession

    Sub New ()
    Set Me.s = New NotesSession
    End Sub

    Function Apply(inParam As Variant ) As Variant

    Dim rtItem As NotesRichTextItem
    Set rtItem = inParam

    Dim nrts As NotesRichTextStyle
    Set nrts = s.Createrichtextstyle() 
    nrts.Underline =True

    Dim color As NotesColorObject
    Set color = s.CreateColorObject
    nrts.NotesColor = color.SetRGB(33, 129, 255)

    Set Apply = nrts
    End Function

    End Class
    '</Стили объекта таблицы>

    Class LinkCell As XCell
    Public LinkDoc As NotesDocument

    Public Sub New()
    cellType = "Link"
    End Sub

    End Class
     
Загрузка...
Похожие Темы - Создание таблицы поле
  1. StarikStarik2705
    Ответов:
    10
    Просмотров:
    2.806
  2. bond0608
    Ответов:
    1
    Просмотров:
    1.397
  3. kreiver
    Ответов:
    0
    Просмотров:
    1.269
  4. Kaiser
    Ответов:
    2
    Просмотров:
    1.794
  5. swyatogor
    Ответов:
    9
    Просмотров:
    180

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