- Create a multivalue, computed for display field (hidden), named 'FldPos' with this formula:
@For(i:=1;i<=@Elements(fldProxiesName);i:=i +1;
sList:=sList : @Text(i)
);
@Trim(sList)
- Create a radio button field, named 'FldPosRB' and select "Use formula for choices" and then on the formula window type:
FldPos
- Then create two Buttons (or Action Hotspots), one called "Move Up" and another "Move Down".
The code for the first button is (for a 3 column table):
' moving up
Sub Click(Source As Button)
Dim ws As New notesuiworkspace
Dim uidoc As notesuidocument
Dim iCurPos As Integer
Dim vFinalList() As Variant
Dim vFinal1List() As Variant
Dim vFinal2List() As Variant
Dim vTemp As Variant
Dim sFieldSelection As String
Dim aFieldNames(2) As String
sFieldSelection = "FldPosRB"
aFieldNames(0)="FldMultivalue1"
aFieldNames(1)="FldMultivalue2"
aFieldNames(2)="FldMultivalue3"
Dim i As Integer
On Error Goto ErrorHandling
Set uidoc = ws.CurrentDocument
If Not isArrayInit(uidoc.document.GetItemValue(aFieldNames(0))) Then
Msgbox "The table is empty." , 64 , "Move up"
Exit Sub
End If
iCurPos =Cint(uidoc.document.getitemvalue(sFieldSelection)(0)) - 1
If iCurPos > 0 Then
For i=0 To Ubound (uidoc.Document.GetItemValue(aFieldNames(0)))
If i = iCurPos - 1 Then 'the position to move to
Redim Preserve vFinalList (i)
vFinalList(i) = uidoc.Document.getitemvalue(aFieldNames(0))(iCurPos)
Redim Preserve vFinal1List (i)
vFinal1List(i) = uidoc.Document.getitemvalue(aFieldNames(1))(iCurPos)
Redim Preserve vFinal2List (i)
vFinal2List(i) = uidoc.Document.getitemvalue(aFieldNames(2))(iCurPos)
Redim Preserve vFinalList (i + 1)
vFinalList(i + 1) = uidoc.Document.getitemvalue(aFieldNames(0))(i)
Redim Preserve vFinal1List (i + 1)
vFinal1List(i + 1) = uidoc.Document.getitemvalue(aFieldNames(1))(i)
Redim Preserve vFinal2List (i + 1)
vFinal2List(i + 1) = uidoc.Document.getitemvalue(aFieldNames(2))(i)
i = i + 1
Else
Redim Preserve vFinalList (i)
vFinalList(i) = uidoc.Document.getitemvalue(aFieldNames(0))(i)
Redim Preserve vFinal1List (i)
vFinal1List(i) = uidoc.Document.getitemvalue(aFieldNames(1))(i)
Redim Preserve vFinal2List (i)
vFinal2List(i) = uidoc.Document.getitemvalue(aFieldNames(2))(i)
End If
'vFinalList =
Next
Call uidoc.document.ReplaceItemValue(aFieldNames(0), vFinalList)
Call uidoc.document.ReplaceItemValue(aFieldNames(1), vFinal1List)
Call uidoc.document.ReplaceItemValue(aFieldNames(2), vFinal2List)
Call uidoc.Document.replaceitemvalue(sFieldSelection, iCurPos)
uidoc.Refresh
uidoc.refresh
End If
errorhandling:
If Err=9 Then 'subscript out of range, one column is empty
Resume Next
Elseif Err>0 Then
Msgbox "Error: " + Error
Goto EndThis
End If
EndThis:
End Sub
And to move down (logical differences in bold):
' moving down
Sub Click(Source As Button)
Dim ws As New notesuiworkspace
Dim uidoc As notesuidocument
Dim iCurPos As Integer
Dim vFinalList() As Variant
Dim vFinal1List() As Variant
Dim vFinal2List() As Variant
Dim sFieldSelection As String
Dim aFieldNames(2) As String
sFieldSelection = "FldPosRB"
aFieldNames(0)="FldMultivalue1"
aFieldNames(1)="FldMultivalue2"
aFieldNames(2)="FldMultivalue3"
Dim i As Integer
On Error Goto ErrorHandling
Set uidoc = ws.CurrentDocument
If Not isArrayInit(uidoc.document.GetItemValue(aFieldNames(0))) Then
Msgbox "The table is empty." , 64 , "Move down"
Exit Sub
End If
iCurPos =Cint(uidoc.document.getitemvalue(sFieldSelection)(0)) - 1
If iCurPos < i="0" style="font-weight: bold;">i = iCurPos Then
Redim Preserve vFinalList (i)
vFinalList(i) = uidoc.Document.getitemvalue(aFieldNames(0))(iCurPos + 1)
Redim Preserve vFinal1List (i)
vFinal1List(i) = uidoc.Document.getitemvalue(aFieldNames(1))(iCurPos + 1)
Redim Preserve vFinal2List (i)
vFinal2List(i) = uidoc.Document.getitemvalue(aFieldNames(2))(iCurPos + 1)
Redim Preserve vFinalList (i + 1)
vFinalList(i + 1) = uidoc.Document.getitemvalue(aFieldNames(0))(iCurPos)
Redim Preserve vFinal1List (i + 1)
vFinal1List(i + 1) = uidoc.Document.getitemvalue(aFieldNames(1))(iCurPos)
Redim Preserve vFinal2List (i + 1)
vFinal2List(i + 1) = uidoc.Document.getitemvalue(aFieldNames(2))(iCurPos)
i = i + 1
Else
Redim Preserve vFinalList (i)
vFinalList(i) = uidoc.Document.getitemvalue(aFieldNames(0))(i)
Redim Preserve vFinal1List (i)
vFinal1List(i) = uidoc.Document.getitemvalue(aFieldNames(1))(i)
Redim Preserve vFinal2List (i)
vFinal2List(i) = uidoc.Document.getitemvalue(aFieldNames(2))(i)
End If
Next
Call uidoc.document.ReplaceItemValue(aFieldNames(0), vFinalList)
Call uidoc.document.ReplaceItemValue(aFieldNames(1), vFinal1List)
Call uidoc.document.ReplaceItemValue(aFieldNames(2),vFinal2List)
Call uidoc.Document.replaceitemvalue(sFieldSelection, iCurPos + 2)
uidoc.Refresh
uidoc.refresh
End If
errorhandling:
If Err=9 Then 'subscript out of range, one column is empty
Resume Next
Elseif Err>0 Then
Msgbox "Error: " + Error
Goto EndThis
End If
EndThis:
End Sub
No comments:
Post a Comment