例: NotesRichTextTable class

次のエージェントは、文書を作成し、文書のリッチテキストアイテム内の表を作成し、文書を保存し、表の取得とプロパティの表示を行います。

%INCLUDE "lsconst.lss"

Sub Initialize
  Dim session As New NotesSession
  Dim db As NotesDatabase
  Set db = session.CurrentDatabase
  REM Create new document with rich text item
  Dim doc As New NotesDocument(db)
  Call doc.AppendItemValue("From", session.UserName)
  Call doc.AppendItemValue("Form", "Main Form")
  Call doc.AppendItemValue _
  ("Subject", Inputbox("Subject?"))
  Dim rti As New NotesRichTextItem(doc, "Body")
  Call rti.AppendText("Paragraph of text")
  Call rti.AddNewLine(2)
  REM Create a table
  Dim rows As Integer, columns As Integer
  rows = 4
  columns = 3
  Dim tabs() As String
  If Messagebox("Do you want a tabbed table?", _
  MB_YESNO + MB_ICONQUESTION, "Tabbed?") = IDNO Then
    Call rti.AppendTable(rows, columns)
  Else
    Redim tabs(1 To rows)
    For i = 1 To rows
      tabs(i) = "Row " & i
    Next
    Call rti.AppendTable(rows, columns, tabs)
  End If
  REM Save the document
  Call doc.Save(True, False)
  REM Get the table
  Dim rtnav As NotesRichTextNavigator
  Set rtnav = rti.CreateNavigator
  If Not rtnav.FindFirstElement(RTELEM_TYPE_TABLE) Then
    Messagebox "Could not find table",, "Fatal error"
    Exit Sub
  End If
  Dim rtt As NotesRichTextTable
  Set rtt = rtnav.GetElement
  labelString = ""
  Forall label In rtt.RowLabels
    If label <> "" Then labelString = labelString & Chr(13) & _
    "  " & label
  End Forall
  If labelString = "" Then labelString = "No labels"
  Messagebox "Columns = " & rtt.ColumnCount & Chr(13) & _
  "Rows = " & rtt.RowCount & Chr(13) & _
  "Labels = " & labelString & Chr(13) & _
  Style = " & rtt.Style & Chr(13) & _
  "Color = " & rtt.Color.NotesColor  & Chr(13) & _
  "AlternateColor = " & rtt.AlternateColor.NotesColor _
  ,, "NotesRichTextTable"
End Sub

次のビューアクションは、4 つの行と 3 つの列で構成された基本的な自動幅の表を作成し、配置します。

Sub Click(Source As Button)
  Dim session As New NotesSession
  Dim db As NotesDatabase
  Set db = session.CurrentDatabase
  REM Create document with Body rich text item
  Dim doc As New NotesDocument(db)
  Call doc.ReplaceItemValue("Form", "Main topic")
  Call doc.ReplaceItemValue("Subject", "Table 4 x 3")
  Dim body As New NotesRichTextItem(doc, "Body")
  REM Create table in Body item
  rowCount% = 4
  columnCount% = 3
  Call body.AppendTable(rowCount%, columnCount%)
  REM Populate table
  Dim rtnav As NotesRichTextNavigator
  Set rtnav = body.CreateNavigator
  Call rtnav.FindFirstElement(RTELEM_TYPE_TABLECELL) 
  For iRow% = 1 To 4 Step 1
    For iColumn% = 1 To 3 Step 1
      Call body.BeginInsert(rtnav)
      Call body.AppendText("Row " & iRow% & ", Column " & iColumn%)
      Call body.EndInsert
      Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
    Next
  Next
  REM Save document and refresh view
  Call doc.Save(True, False)
  Dim ws As New NotesUIWorkspace
  Call ws.ViewRefresh
End Sub

次のエージェントは、アイテム内の最初の表のセルを取得し、各セルの最初のテキスト段落を表示します。

Sub Initialize
  Dim session As New NotesSession
  Dim db As NotesDatabase
  Set db = session.CurrentDatabase
  Dim dc As NotesDocumentCollection
  Set dc = db.UnprocessedDocuments
  Dim doc As NotesDocument
  Set doc = dc.GetFirstDocument
  Dim rti As NotesRichTextItem
  Set rti = doc.GetFirstItem("Body")
  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
  Dim rtt As NotesRichTextTable
  Set rtt = rtnav.GetElement
  Dim rtrange As NotesRichTextRange
  Set rtrange = rti.CreateRange
  Call rtnav.FindFirstElement(RTELEM_TYPE_TABLECELL)
  firstFlag = True
  For i& = 1 To rtt.RowCount
    For j& = 1 To rtt.ColumnCount
      If Not firstFlag Then
        Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
      Else
        firstFlag = False
      End If
      Call rtrange.SetBegin(rtnav)
      Messagebox rtrange.TextParagraph,, _
      "Row " & i& & _
      ", Column " & j&
    Next
  Next
End Sub