发信人: 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]
|
|