Hi,
I'm traying to build a recursive CopyValue(aVariant) function. The idea
is a simple copy for scalar values, a recursive Items copy for array
(max 5 dimensions arrays), and a call to Clone() method for (pseudo)
objects. The function can't copy structures, I will use (pseudo) objects
Clone() method...
But my code (Cf. "TEST COPY VALUE CODE" below) failed at CopyArray in
Select Case 2 at line :
result(i1 - Bounds(1,1), i2 - Bounds(2,1)) = CopyValue(value)
The error message (in french) is :
"L'erreur #91 (Variable d'objet non définie) s'est produite à la ligne
90 dans _DataUtil"
The error is triggered with the recursive function call at
CopyValue(value). It look's like reentrance is not supported by the
function... I'm using LibreOffice 5.2.7.2. (x32) with Linux Debian. I
tested also with LIbreOffice 5.4.2.2 (x64) with Windows.
So to test recursive call I tried with a recursive sample function,
CalculateFactorial(Number). And it's work fine. The sample is :
Sub TestFactorial
Msgbox CalculateFactorial( 42 ) ' Displays 1,40500611775288E+51
Msgbox CalculateFactorial( -42 ) ' Displays "Invalid number for
factorial!"
Msgbox CalculateFactorial( 3.14 ) ' Displays "Invalid number for
factorial!"
End Sub
Function CalculateFactorial( Number )
If Number < 0 Or Number <> Int( Number ) Then
CalculateFactorial = "Invalid number for factorial!"
ElseIf Number = 0 Then
CalculateFactorial = 1
Else
' This is the recursive call:
CalculateFactorial = Number * CalculateFactorial( Number - 1 )
Endif
End Function
I'm wondering If my problem is coming from the fact recursive call could
be only at result affectation line. In this sample it's the line :
CalculateFactorial = Number * CalculateFactorial( Number - 1 )
But I can't imagine a simple way to do the same with my algorithm,
because copying an array need a For Next recursive call for each item
... An array is not a Lisp list ...
I may imagine two solutions :
1. Using Lisp paradigm with first() and rest() functions, splitting
array... But how to build an array reference starting with LBound()+1
item of the array ?
2. Trying serialize the recursive array to a large String value and use
an other unserialize function to rebuild the structure ....
Do you know if an other CopyValue already exist ? An other Idea ?
Thank you for your advises !
Patrick
Rem
--------------------------------------------------------------------------------------------------
Rem TEST COPY VALUE CODE
Rem
--------------------------------------------------------------------------------------------------
Sub TestCopyValue()
Dim tableau(1 to 3, 1 to 2)
Dim result As Variant
tableau(1,1) = "AZERTY"
tableau(1,2) = 12
tableau(2,1) = Array("item1", "item2")
tableau(2,2) = Array(Array("11", "12"), Array("21", "22"))
tableau(3,1) = "A"
tableau(3,2) = 99
result = CopyValue(tableau)
End Sub
' #FONCTION#
==================================================================
' Nom. ..........: ArrayDim
' Description ...: Un tableau avec les indices de chaque dimension du
tableau
' en parametre. Le nombre maximum de dimension du
tableau
' en parametre est limité à 5 sinon une exception n°9
' est émise.
' Parametres ....:
' Syntaxe .......:
' Resultat ..... : La première célule de la première ligne du tableau
Result(0, 1)
' contient le nombre de dimensions. Les lignes
Result(1, ) à
' Result(5, ) contiennent les deux indices LBound()
et UBound()
' de chaque dimension.
' Auteur ........: Patrick
' Modifié .......:
' Remarques .....:
' Relations .....:
' Liens .........:
' Example .......:
Function ArrayDim(anArray As variant) As Variant
Dim Bounds(0 to 6, 1 to 2) As Long 'Le couple des index
(LBound,UBound) d'une dimension du tableau
Dim i As Integer
on local error goto Exit_Function
for i = 1 to 6 step 1
Bounds(i, 1) = LBound(anArray(), i)
Bounds(i, 2) = UBound(anArray(), i)
Next
Exit_Function:
On Error Resume Next
If not EstVide(Bounds(6, 1)) Then
Err = 9 'Index hors de la plage définie. Exit !
Exit Function
EndIf
'Par convention, le nombre de dimensions est indiqué
'dans la première ligne du tableau.
Bounds(0,1) = i-1
ArrayDim = Bounds
End Function
' #FONCTION#
==================================================================
' Nom. ..........: CopyArray
' Description ...: Copie un tableau par valeur de manière récursive.
' Parametres ....: aVariant as variant : Un tableau
' Syntaxe .......:
' Resultat ..... : Le résultat est toujours un tableau de variant. La
limite
' LBound est toujours 0, il y a donc un offset
UBound() - LBound()
' des indices du tableau original.
' Auteur ........: Patrick
' Modifié .......:
' Remarques .....:
' Relations .....:
' Liens .........:
' Example .......:
Function CopyArray(aVariant() As Variant) As Variant
Dim result As Variant
Dim Bounds As Variant
Dim i1,i2, i3, i4, i5 As Long
Dim value As Variant
On local error Goto Erreur
Set Bounds = ArrayDim(aVariant)
Select Case Bounds(0,1)
Case 1
result = DimArray(Bounds(1, 2) - Bounds(1, 1))
For i1 = Bounds(1, 1) to Bounds(1, 2) Step 1
value = aVariant(i1)
result(i1 - Bounds(1,1)) = CopyValue(value)
Next
Case 2
result = DimArray(Bounds(1, 2) - Bounds(1, 1), _
Bounds(2, 2) - Bounds(2, 1))
For i1 = Bounds(1, 1) to Bounds(1, 2) Step 1
For i2 = Bounds(2, 1) to Bounds(2, 2) Step 1
value = aVariant(i1, i2)
result(i1 - Bounds(1,1), i2 - Bounds(2,1)) =
CopyValue(value)
Next
Next
Case 3
result = DimArray(Bounds(1, 2) - Bounds(1, 1), _
Bounds(2, 2) - Bounds(2, 1), _
Bounds(3, 2) - Bounds(3, 1))
For i1 = Bounds(1, 1) to Bounds(1, 2) Step 1
For i2 = Bounds(2, 1) to Bounds(2, 2) Step 1
For i3 = Bounds(3, 1) to Bounds(3, 2) Step 1
value = aVariant(i1, i2, i3)
result(i1 - Bounds(1,1), i2 - Bounds(2,1), i3 -
Bounds(3,1)) = CopyValue(value)
Next
Next
Next
Case 4
result = DimArray(Bounds(1, 2) - Bounds(1, 1), _
Bounds(2, 2) - Bounds(2, 1), _
Bounds(3, 2) - Bounds(3, 1), _
Bounds(4, 2) - Bounds(4, 1))
For i1 = Bounds(1, 1) to Bounds(1, 2) Step 1
For i2 = Bounds(2, 1) to Bounds(2, 2) Step 1
For i3 = Bounds(3, 1) to Bounds(3, 2) Step 1
For i4 = Bounds(4, 1) to Bounds(4, 2) Step 1
value = aVariant(i1, i2, i3, i4)
result(i1 - Bounds(1,1), i2 - Bounds(2,1),
i3 - Bounds(3,1), i4 - Bounds(4,1)) = CopyValue(value)
Next
Next
Next
Next
Case 5
result = DimArray(Bounds(1, 2) - Bounds(1, 1), _
Bounds(2, 2) - Bounds(2, 1), _
Bounds(3, 2) - Bounds(3, 1), _
Bounds(4, 2) - Bounds(4, 1), _
Bounds(5, 2) - Bounds(5, 1))
For i1 = Bounds(1, 1) to Bounds(1, 2) Step 1
For i2 = Bounds(2, 1) to Bounds(2, 2) Step 1
For i3 = Bounds(3, 1) to Bounds(3, 2) Step 1
For i4 = Bounds(4, 1) to Bounds(4, 2) Step 1
For i4 = Bounds(5, 1) to Bounds(5, 2) Step 1
value = aVariant(i1, i2, i3, i4, i5)
result(i1 - Bounds(1,1), i2 -
Bounds(2,1), i3 - Bounds(3,1), i4 - Bounds(4,1), i5 - Bounds(5,1)) =
CopyValue(value)
Next
Next
Next
Next
Next
End Select
CopyArray = result
Exit_Function:
Exit Function
Erreur:
TraceError("ERROR", Err, Name, Erl)
Goto Exit_Function
End Function
' #FONCTION#
==================================================================
' Nom. ..........: CopyValue
' Description ...: Copie un variant par valeur (de manière récursive
dans le cas
' d'un tableau).
' Parametres ....: aVariant as variant : Un scalaire, sinon un tableau
ou encore
' un objet avec une methode Clone(). Ne supporte pas
un argument
' de type structure.
' Syntaxe .......:
' Resultat ..... : Une copie du variant. Dans le cas d'un tableau,
' le résultat est toujours un tableau de variant. La
limite
' LBound est toujours 0, il y a donc un offset
UBound() - LBound()
' des indices du tableau original.
' Auteur ........: Patrick
' Modifié .......:
' Remarques .....:
' Relations .....:
' Liens .........:
' Example .......:
Function CopyValue(aVariant as variant) As Variant
Dim result As Variant
Dim value As Variant
On local error Goto Erreur
Rem Clauses appelant une récursion ...
If IsArray(aVariant) Then
result = CopyArray(aVariant)
Rem Clauses pour arrêter la récursion
ElseIf IsObject(aVariant) Then
result = aVariant.Clone()
Else
'Copie par valeur d'un variant
Select Case VarType(aVariant)
Case 8 'String
result = Left(aVariant, Len(aVariant)) 'Copy value avec la
fonction 'Left()'...
Case 0 'Empty
'exit sans aucune affectation vaut la valeur retour empty...
'Ne surtout pas essayer d'affecter l'objet 'Nothing'
Exit Function
Case 1 'Null
result = Null
Case else
result = aVariant
End Select
EndIf
CopyValue = result
Exit_Function:
Exit Function
Erreur:
TraceError("ERROR", Err, Name, Erl)
Goto Exit_Function
End Function