2008-04-03

Notes: How to re-order rows on a 'dynamic' table

If you have a 'dynamic' table where each column is composed by a multivalue field and you want to be able to change a row's position, then you can do it like this:

  • 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