DominoArea.org [Archive]

Bonjour
je n'arrive pas a tester si un champs texte riche est vide ?
En fait il s'agit d'un champs texte riche amélioré Vignette mais je pense que le problème est le même

merci de votre aide

salut

essais ça

Code : Tout sélectionner

Public Function RichTextIsEmpty(wField As String, wDoc As notesDocument) As Boolean
   REM Cette fonction détect si un champ text riche est vide.
   REM renvoi true or false en fonction du champ text riche passé en paramatre
   Dim rtItem As NotesRichTextItem
   Dim vrValue As Variant
   
   On Error Goto CatchError
   
   RichTextIsEmpty = True
   
   REM controle si le nom du champ est renseigné
   If  Trim(wfield) = "" Then
      Error 9999,"wField vide"
      Exit Function
   End If   
   
   REM controle si le document existe
   If wDoc Is Nothing Then
      Error 9999,"wDoc is Nothing"
      Exit Function
   End If
   
   If wDoc.HasItem(wField) = False Then      
      Exit Function
   End If
      
   REM si le champ est de type richtext
   Set vrValue = wDoc.getFirstItem(Trim(wField))
   If vrValue Is Nothing Then
      Exit function
   End If
   If vrValue.Type <> 1 Then
      Error 9999,Trim(wField)+" is not a RichtextItem, type = "+CStr(vrValue.Type)      
      Exit Function
   End If
   vrValue = Null
   REM initialise la variable richText
   Set rtItem = wDoc.getFirstItem(wField)
   
   REM si le champ exitse
   If rtItem Is Nothing Then      
      Exit Function
   End If
   
   REM controle si le champ contient une valeur
   vrValue = rtItem.Values
   If Isarray(vrValue) Then
      Set rtItem = Nothing
      RichTextIsEmpty = False
      Exit Function
   Else
      If Vartype(vrValue) = 8 Then
         If Len(vrValue) > 0 Then
            Set rtItem = Nothing
            RichTextIsEmpty = False
            Exit Function
         End If
      End If
   End If
   
   REM Controle si le champ contient un fichie rattaché
   If RichTextIsEmpty = True Then
      If Isarray(rtItem.EmbeddedObjects) Then
         RichTextIsEmpty = False
         Exit Function
      End If
   End If   
   
   Set rtItem = Nothing
   
   Exit Function
CatchError:
   MsgBox "("+Structure_Log+" : "+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Error " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Line # "+Cstr(Erl),16," ERROR !"
   RichTextIsEmpty = True    
   Set rtItem = Nothing
   Exit Function
End Function