... ich weiß nicht, ob ich das richtige sehe: als Rückgabe bleiben dann die verblieben Aliase im versteckten Feld.
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
