Domino 9 und frühere Versionen > ND7: Entwicklung

Prompt mit Alias in LS

<< < (2/2)

ata:
... ich weiß nicht, ob ich das richtige sehe: als Rückgabe bleiben dann die verblieben Aliase im versteckten Feld.

Ich löse es per Arrays:


--- Code: ---Option Explicit
Function GetLabelAlias( vArray As Variant , vLabel As Variant , vAlias As Variant , vDefault As Variant , vDefaultLabel As Variant , sSep As String ) As Variant
   ' # Trennt in den Text-Listen vArray und vDefault durch das Trennzeichen sSep verbundenen Label- und Alias-Werte auf.
   ' # @Param
   ' # vArray = String-Array => mit allen Einträgen nach dem Muster => Label & sSep & sAlias
   ' # vLabel = String-Array => leeres Array
   ' # vAlias = String-Array => leeres Array
   ' # vDefault = String-Array => mit allen Einträgen nach dem Muster => Label & sSep & sAlias
   ' # vDefaultLabel = String-Array => leeres Array
   ' # sSep = String => das Trennzeichen zwischen Label und Alias
   ' # @Return
   ' # Rückgabe ist True oder False
   On Error GoTo ErrorHandle
   Dim sTrenn As String
   Dim sDummy( 0 to 0 ) As String
   Dim vSelection As Variant
   Dim vResult As Variant
   Dim vValue As Variant
   Dim i As Integer
   '
   sDummy( 0 ) = ""
   GetLabelAlias = False
   vLabel = sDummy
   vAlias = sDummy
   vDefaultLabel = sDummy
   vResult = sDummy
   '
   ' # Validierung der Übergabeparameter
   If Not IsArray( vArray ) Then
      Exit Function
   End If
   '
   ' # Parsen des Trennzeichens
   If Instr( vArray(0) , " " & sSep & " " ) > 0 Then
      sTrenn = " " & sSep & " "
   ElseIf Instr( vArray(0) , sSep ) > 0 Then
      sTrenn = sSep
   Else
      sTrenn = ""
   End If
   Print {"} & sTrenn {"}
   '
   ' # Label und Alias trennen
   If sTrenn <> "" Then
      For i = LBound( vArray ) to UBound( vArray )
         vValue = Split( vArray( i ) , sTrenn )
         If vLabel( 0 ) = "" Then
            vLabel( 0 ) = vValue( 0 )
            vAlias( 0 ) = vValue( 1 )
            vResult( 0 ) = ""
         Else
            vLabel = ArrayAppend( vLabel , vValue( 0 ) )
            vAlias = ArrayAppend( vAlias , vValue( 1 ) )
            vResult = ArrayAppend( vResult , "" )
         End If
      Next
      '
      ' # vDefault trennen
      If IsArray( vDefault ) Then
         For i = LBound( vDefault ) to UBound( vDefault )
            vValue = Split( vDefault( i ) , sTrenn )
            If vDefaultLabel( 0 ) = "" Then
               vDefaultLabel( 0 ) = vValue( 0 )
            Else
               vDefaultLabel = ArrayAppend( vDefaultLabel , vValue( 0 ) )
            End If
         Next
      Else
         vValue = Split( vDefault , sTrenn )
         vDefaultLabel = vValue( 0 )
      End If     
   Else
      vLabel = vArray
      vAlias = vArray
      vDefaultLabel = vDefault
      Redim vResult ( 0 to Ubound( vAlias ) )
   End If
   '
   GetLabelAlias = True
   '
WayOut:
Exit Function
ErrorHandle:
   MsgBox |FEHLER | & err & | in GetLabelAlias => | & Error , 16 , |Fehler in Zeile | & Erl 
   Resume WayOut
End Function
Function RemoveFromAliasList( vArray As Variant , sSep As String , sMode As String , vDefault As Variant ) As Variant
   ' # Entfernt per Auswahlliste aus der Textliste vArray Werte, die mit dem Trennzeichen sSep miteinander verbunden sind.
   ' # @Param
   ' # vArray = String-Array => mit allen Einträgen nach dem Muster => Label & sSep & sAlias
   ' # sSep = String => das Trennzeichen zwischen Label und Alias
   ' # sMode = String => die Form der Auswahl
   ' # ... sMode = "single" => Einzelwert selektierbar
   ' # ... sMode = "multiple" => Mehrfachwert selektierbar
   ' # vDefault = String-Array oder String => vorbelegte Werte in der Auswahlliste - muß denselben Aufbau haben wie vArray
   ' # @Return
   ' # Rückgabe ist ein Array mit allen entfernten Alias-Werten
   On Error GoTo ErrorHandle
   Dim sTrenn As String
   Dim sDummy( 0 to 0 ) As String
   Dim vLabel As Variant
   Dim vAlias As Variant
   Dim vDefaultLabel As Variant
   Dim vSelection As Variant
   Dim vResult As Variant
   Dim vValue As Variant
   Dim i As Integer
   '
   vResult = sDummy
   '
   ' # Trennung von Label und Alias
   If GetLabelAlias( vArray , vLabel , vAlias , vDefault , vDefaultLabel , sSep ) Then
      ' # OK
   Else
      Print "Abbruch - Die Trennung von Label und Alias war nicht erfolgreich!"
      Exit Function
   End If
   Redim vResult( 0 to UBound( vAlias ) )
   '
   ' # Werte per Label auswählen
   vSelection = SelectFromList( vLabel , sMode , vDefaultLabel )
   '
   ' # Validierung der ausgewählten Werte
   If Not IsArray( vSelection ) Then
      Print "Abbruch - es wurden keine Werte zum Entfernen ermittelt"
      Exit Function
   End If
   '
   ' # Rückgabe-Array erstellen
   Forall sSelect In vSelection
      If Cstr( sSelect ) = "" Then
         Print "Abbruch - die Auswahl war leer"
         Exit Function
      End If
      i = ArrayGetIndex( vLabel , Cstr( sSelect ) )
      vArray( i ) = ""
      vResult( i ) = vAlias( i )
   End Forall
   '
   ' # Rückgabe
   vArray = Fulltrim( vArray )
   RemoveFromAliasList = Fulltrim( vResult )
   '
WayOut:
Exit Function
ErrorHandle:
   MsgBox |FEHLER | & err & | in RemoveFromAliasList => | & Error , 16 , |Fehler in Zeile | & Erl
   Resume WayOut
End Function
Function SelectFromList( vArray As Variant , sMode As String , vDefault As Variant ) As Variant
   ' # Gibt per Auswahlliste selektierte Werte zurück
   ' # @Param
   ' # vArray = StringArray => enthält eine Liste von Werten
   ' # sMode = String => übergibt den Modus der Auswahl:
   ' # ... sMode = "single" => es ist nur eine einfache Wertauswahl möglich
   ' # ... sMode = "multiple" => es ist nur eine Mehrfachauswahl möglich
   ' # vDefault = Vorbelegte Werte in der Auswahl
   ' # @Return
   ' # Textliste mit den ausgewählten Werten
       On Error GoTo ErrorHandle
       Dim ws As New NotesUIWorkspace
       Dim vResult As Variant
       Dim vReturn(  ) As String
       Dim sDummy( 0 )
       Dim i As Integer
       sDummy(0) = ""
      '
      ' # Auswahl     
      If sMode = "single" Then
         vResult = ws.Prompt( PROMPT_OKCANCELLIST, "Auswahl", "Wählen Sie einen Eintrag", vDefault , vArray )
      Else
         vResult = ws.Prompt( PROMPT_OKCANCELLISTMULT, "Mehrfach-Auswahl", "Wählen Sie einen oder mehrere Einträge", vDefault , vArray )
      End If
      '
      ' # Rückgabe vorbereiten
      If IsArray( vResult ) Then
         For i = 0 to UBound( vResult )
            Redim Preserve vReturn( 0 to i )
            vReturn( i ) = Cstr( vResult( i ) )
         Next
      Else
         Redim vReturn( 0 to 0 )
         vReturn( 0 ) = vResult
      End If
      '
      ' # Rückgabe
      SelectFromList = vReturn
      '
WayOut:
Exit Function
ErrorHandle:
   MsgBox |FEHLER | & err & | in SelectFromList => | & Error , 16 , |Fehler in Zeile | & Erl 
   Resume WayOut
End Function
Sub Initialize( )
   On Error GoTo ErrorHandle
   ' # lokale Deklarationen...
   Dim session As New NotesSession
   Dim ws As New NotesUIWorkspace
   Dim docThis As NotesDocument
   Dim vArray As Variant
   '
   Set docThis = ws.CurrentDocument.Document
   '
   vArray = docThis.List_1
   '
   docThis.List_3 = RemoveFromAliasList( vArray , "|" ,  "multiple" , docThis.List_2 )
   docThis.List_4 = vArray
WayOut:
Exit Sub
ErrorHandle:
   MsgBox |FEHLER | & err & | in  Initialize => | & Error , 16 , |Fehler in Zeile | & Erl
   Resume WayOut
End Sub
--- Ende Code ---
Im Handling sieht das dann so aus wie in der angehängten Grafik

Toni

mlotus:
Hallo Toni

nochmals vielen Dank für die super Hilfe, funktioniert perfekt  ;)

Gruss
Martin

ata:
... freut mich, dann hatten die Codeschnipsel ja noch was...

Toni

Navigation

[0] Themen-Index

[*] Vorherige Sete