リッチテキストフィールドに表を作成する

%REM
	Agent 表
	Created 2015/12/15 by Takeshi Yoshida
	Description: リッチテキストフィールドに表のある文書を新規に作成する
%END REM
Option Public
Option Declare
%Include "lsconst.lss"
Sub Initialize
	Dim session As New NotesSession
	Dim db As NotesDatabase
	Dim doc As NotesDocument
	Dim rti As NotesRichTextItem
	Dim rows As Integer
	Dim columns As Integer
	Dim i As Integer
	Dim ws As New NotesUIWorkspace
	Dim rtpsCols(1) As Variant	'列のスタイルの格納用。0 から始まるため、（列数-1）の数値を指定

	Set db = session.CurrentDatabase
	Set doc = db.Createdocument
	Set rti = New NotesRichTextItem(doc,"Body")	'表を作成するリッチテキストフィールド

	'********************* 表の作成 **********************************
	'表の作成
	rows = 5	'行数
	columns = 2	'列数

	'1列目のスタイルの設定
	Set rtpsCols(0) = session.CreateRichTextParagraphStyle
	rtpsCols(0).Alignment = 0	'文字のプロパティ：文字揃え:0->左揃え, 1->右揃え, 2->プロパティの4つ目の設定。名前不明, 3->中央揃え 
	rtpsCols(0).Firstlineleftmargin = RULER_ONE_CENTIMETER * 0.1	'段落開始位置（ルーラーの上の設定。悩んだら左余白と同じで良い）
	rtpsCols(0).Leftmargin = RULER_ONE_CENTIMETER * 0.1				'左余白
	'右余白を明示的に設定して列幅を制御（"RULER_ONE_CENTIMETER * [数値]" で cm となる）
	rtpsCols(0).RightMargin = RULER_ONE_CENTIMETER * 2

	'2列目のスタイルの設定
	Set rtpsCols(1) = session.CreateRichTextParagraphStyle
	rtpsCols(1).Alignment = 0
	rtpsCols(1).Firstlineleftmargin = RULER_ONE_CENTIMETER * 0.1	'段落開始位置（ルーラーの上の設定。悩んだら左余白と同じで良い）
	rtpsCols(1).Leftmargin = RULER_ONE_CENTIMETER * 0.1				'左余白
	
	'右余白を明示的に設定して列幅を制御（"RULER_ONE_CENTIMETER * [数値]" で cm となる）
	rtpsCols(1).RightMargin = RULER_ONE_CENTIMETER * 8
	

	'表の追加
	'パラメータ：行数, 列数, タブ（"" = タブなし）, twips 単位の表の左余白。デフォルトは 1440, 固定幅列とスタイル属性
	Call rti.AppendTable(rows,columns,"",RULER_ONE_INCH,rtpsCols)

	'表オブジェクトの取得
	Dim rtnav As NotesRichTextNavigator
	Set rtnav = rti.CreateNavigator
	Dim rtt As NotesRichTextTable
	Set rtt = rtnav.GetFirstElement( RTELEM_TYPE_TABLE )

	'行の追加　（途中で追加したい場合、行数を指定）
	'Call rtt.AddRow(5)
	
	'********************* セルへの入力 **********************************
	'最初のセルを取得
	Call rtnav.FindFirstElement(RTELEM_TYPE_TABLECELL)
	Dim iRow As Integer
	Dim iColumn As Integer
	For iRow = 1 To rows Step 1
		If iRow = 1 Then
		'-------- ヘッダー（タイトル行） ----------------
			'列数分繰り返す
			For iColumn = 1 To columns Step 1
				'挿入位置をセルの先頭に設定し直します。
				Call rti.BeginInsert(rtnav)
				'テキストを挿入
				Call rti.AppendText("Title　" & iColumn)
				'挿入位置をリッチテキストアイテムの最後に設定し直します。
				Call rti.EndInsert
				'次のセルを取得
				Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
			Next
			
		Else
		'-------- 二行目以降 -----------------------
		'列数分繰り返す
			For iColumn = 1 To columns Step 1
				'挿入位置をセルの先頭に設定し直します。
				Call rti.BeginInsert(rtnav)
				If iColumn = 1 Then
					'文書リンクを挿入（リンク先の NotesDocument を設定。以下はダミーで自分自身を指定しています。実際には適切な NotesDocument を設定してください。）
					Call rti.Appenddoclink(doc, "コメント。リンクの説明。")
				Else
					'テキストを挿入
					Call rti.AppendText("Row " & iRow & ", Column " & iColumn)
				End If
				'挿入位置をリッチテキストアイテムの最後に設定し直します。
				Call rti.EndInsert
				'次のセルを取得
				Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
			Next
		End If
	Next

	'********************* デザイン/スタイル **********************************
	'「表」プロパティの「表/セルの背景色」の「表の色」の「スタイル」のセット
	rtt.Style = TABLESTYLE_TOP
	
	'基本色
	Dim colorObject As NotesColorObject
	Set colorObject = session.CreateColorObject
	colorObject.NotesColor = colorObject.SetRGB(200, 200, 200)	'RGB で指定。但し、近似色に変換される
	Call rtt.SetColor(colorObject)
	'代替色
	colorObject.NotesColor = COLOR_WHITE
	Call rtt.SetAlternateColor(colorObject)
	
	'************************** 保存 ***************************************
	Call doc.Save(True, False)
	
	call ws.Viewrefresh	
End Sub

Select XSnippet to copy to Clipboard