发信人: realwater()
整理人: kamkam(2002-05-01 23:43:08), 站内信件
|
存盘前保证此域有值
kamkam reply:
乱码部分是我自己的中文注释，这段程序来自notes.net 和dingxiang.163.net
局限是要借助uidoc，所以只能检查当前ui界面文档，不能检查后台文档，使用注意
Function IsRTFNull(rtfield As String) As Integer
'This function tests a Rich Text field to see whether or not it is null
. It returns TRUE if the field is null, and 'returns FALSE if the field i
s not null. It works even if the rich text field contains a file attachment
, 'doclink, or OLE object but does not contain any text.
'???????rich text?????,????,????,?????????????attachment , document lin
k , ole object????????
'?????notes.net , dingxiang.163.net
'?????????uidoc??????,????????
On Error Goto Errhandle
Dim workspace As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim currentfield As String
Set uidoc = workspace.CurrentDocument 'Store the name of the field
that currently has focus. Note: if this function is being called from a f
orm button, 'currentfield will be null (because the button has the focus,
and not a field). If this function is called 'from an action button, and
if the cursor is in a field, then currentfield will correctly store the name
'of the field that has focus.
currentfield = uidoc.CurrentField
Call uidoc.GotoField(rtfield)
Call uidoc.SelectAll 'The next line will generate a 4407 error
message if the Rich Text Field is null
Call uidoc.DeselectAll 'Return the cursor the the field that had
focus before this function ran. If the currentfield variable is null (becau
se a button 'or hotspot had focus, then the cursor will actually wind up g
etting left in the rich text field.
If currentfield <> "" Then
Call uidoc.GotoField(currentfield)
End If
IsRTFNull = False
Exit Function
Errhandle:
Select Case Err
Case 4407 'the DeselectAll line generated an error
message, indicating that the rich text field does not contain anything
If currentfield <> "" Then
Call uidoc.GotoField(currentfield)
End If
IsRTFNull = True
Exit Function
Case Else 'For any other error, force the same erro
r to cause LotusScript to do the error handling
Error Err
End Select
End Function
--
※ 来源:．月光软件站 http://www.moon-soft.com．[FROM: 168.160.71.113]
|
|