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

%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





リッチテキストフィールドに表のある文書を新規に作成するエージェントです。
例として、"Body" フィールドに 5 行、2列の表がある文書を作成します。
(表にはタイトル、文書リンク、行数、列数を設定しています)

LotusScript
tyoshida
December 15, 2015 at 5:06 PM
Rating
0





No comments yetLogin first to comment...