新規文書にリッチな初期値を設定する

新規文書を作成するときに、リッチテキスト・フィールドへ初期値を設定しておきたい場合があります。

もちろんリッチテキスト・フィールドにもデフォルト値を設定できますが、値は文字列でなければなりません。

もし初期値として色つきの文字や特定のフォントにしたり、表やリンク、あるいは添付ファイルを張り付けておきたい、などといった場合は作りこみが必要です。

そこで、初期値としてのひな型を作成する機能と、作成したひな型のリッチテキストフィールドの内容をコピーして編集モードで開いている文書へペーストする機能を作ってみました。

テンプレートを編集するフォーム "Template" を作ります。
フィールドは２つ、テキストの"Subject"とリッチテキストの"Body"を追加します。
"Subject"は読み込みモードの時とクリップボードへコピーする時に非表示になるよう設定します。

テンプレートを選択するためのビュー"Templates"を作ります。
ビューの1列目に"Subject"を表示します。

次は新規文書を作成するアクションボタンの Lotus Script です。
ここではひな型の名前等を固定で指定しちゃっています。

Sub Click(Source As Button)
    Dim ws As New NotesUIWorkspace
    Dim tdoc As NotesDocument
    Dim ss As New NotesSession
    Dim db As NotesDatabase
    Dim vw As NotesView
    Dim templateName$
    Set db = ss.CurrentDatabase
    Set vw = db.GetView( "Templates" )
    Set tdoc = vw.GetDocumentByKey( "Default Template", True )
    If tdoc Is Nothing Then Exit Sub
    Dim uidoc As NotesUIDocument
    Set uidoc = ws.EditDocument( False, tdoc, True )
    Call uidoc.SelectAll
    Call uidoc.Copy
    Call uidoc.Close( True )
    Dim cuidoc As NotesUIDocument
    Set cuidoc = ws.ComposeDocument( db.Server, db.FilePath, "MainTopic")
    Call cuidoc.GotoField( "Body" )
    Call cuidoc.Paste
End Sub

これを実行すると、画面が一瞬フラッシュしたように見えることがありますが、それは気にしちゃいけません。
もし NotesUIDocument.Visible といったプロパティがあって、False をセットすると非表示にできちゃったりなんかすると解決できそうなんですが...

次は編集モードで開いている文書へひな型を挿入したい場合にアクションボタンへ記述する Lotus Script です。
このボタンは読み込みモードのときに非表示にします。

Sub Click(Source As Button)
    Dim ws As New NotesUIWorkspace
    Dim cuidoc As NotesUIDocument
    'リッチテキスト"Body"に挿入点がない場合はエラー
    Set cuidoc = ws.CurrentDocument
    If cuidoc.CurrentField <> "Body" Then
        Messagebox "現在の項目へは挿入できません。",, "エラー"
        Exit Sub
    End If
    'ひな型を選択する
    Dim ss As New NotesSession
    Dim db As NotesDatabase
    Dim dc As NotesDocumentCollection
    Dim tdoc As NotesDocument
    Set db = ss.CurrentDatabase
    Set dc = ws.PickListCollection( 3, False, 
    db.Server, db.FilePath, "Templates", _
    "選択", "ひな型を選択してください。" )
    If dc.Count = 0 Then Exit Sub
    Set tdoc = dc.GetFirstDocument
    'ひな型をクリックボードへコピーする
    Dim uidoc As NotesUIDocument
    Set uidoc = ws.EditDocument( False, tdoc, True )
    Call uidoc.SelectAll
    Call uidoc.Copy
    Call uidoc.Close( True )
    'クリップボードからペーストする
    Call cuidoc.Paste
End Sub