Mettre à jour un Treeview

Le
rmillerlcxl
Bonjour,

J'utilise un Treeview. Par un bouton … Par exemple … j'ajou=
te un document externe à un élément du Treeview qui va se pl=
acer en retrait (donc un child je crois bien) en dessous de l'élé=
ment.

Mon problème est que je reproduit le Treeview au complet à chaque=
ajout. Et alors la macro MakeFamilyTree … voir ci dessous est lanc=
ée.

Comment je pourrais faire pour mettre à jour que l'élément s=
électionné et que donc dans le Treeview le texte de l'ajout puiss=
e aller se placer en dessous de celui-ci mais sans tout reproduire de z=
ro. Mon but est évidemment que cela se fasse énormément p=
lus vite. Est-ce possible d'éviter le MakeFamilyTree?

Merci à l'avance.



'**************************************************************************=
*****

Sub MakeFamilyTree()

Dim arrName As Variant
Dim arrParent As Variant
Dim arrMatrix() As Variant
Dim arrTemp As Variant
Dim elm As Variant
Dim i As Long, j As Long
Dim ret As Variant
Dim Node As Node
Dim bExists As Boolean

'Reset Tree View control
UF_Treeview.TreeViewAvis.Nodes.Clear

'Get data from the worksheet as an array
With Feuil3.Range("CN_TreeviewColAZone")
arrName = .Offset(0, 1).Value
arrParent = .Offset(0, 2).Value
End With

'Sorting in an array
ReDim arrMatrix(1 To UBound(arrName), 1 To 1)
For Each elm In arrParent
i = i + 1
ret = Application.Match(elm, arrName, 0)
If IsError(ret) Then
arrMatrix(i, 1) = arrName(i, 1)
Else
j = 3
ReDim Preserve arrMatrix(1 To UBound(arrMatrix), 1 To j)
arrMatrix(i, 1) = arrName(i, 1)
arrMatrix(i, 2) = elm
arrMatrix(i, 3) = arrParent(ret, 1)

Do
ret = Application.Match(arrParent(ret, 1), arrName, 0)
If IsError(ret) Then
Exit Do
End If

If arrParent(ret, 1) = "" Then
Exit Do
End If

j = j + 1
ReDim Preserve arrMatrix(1 To UBound(arrMatrix), 1 To j)
arrMatrix(i, j) = arrParent(ret, 1)
Loop
End If
Next

arrTemp = CustomTranspose(arrMatrix)

'Let's add each data to nodes
For i = 1 To UBound(arrTemp)
For j = 1 To UBound(arrTemp, 2)
If Not IsEmpty(arrTemp(i, j)) Then
With UF_Treeview.TreeViewAvis
bExists = False
For Each elm In .Nodes
If elm = arrTemp(i, j) Then
bExists = True
End If
Next
If Not bExists Then
If j = 1 Then
If arrTemp(i, j) <> "" And arrTemp(i, j) <> " - " T=
hen
Set Node = .Nodes.Add(, , arrTemp(i, j), arrT=
emp(i, j))
End If
Else
If arrTemp(i, j) <> "" And arrTemp(i, j) <> " - " T=
hen
Set Node = .Nodes.Add(arrTemp(i, j - 1), tvwC=
hild, arrTemp(i, j), arrTemp(i, j))
End If
End If
Node.Expanded = True
End If
End With
End If
Next
Next

End Sub
Function CustomTranspose(ByVal buf As Variant) As Variant
'Transpose an order of an array from Parent to Child
Dim arrTemp() As Variant
Dim i As Long, j As Long, K As Long
ReDim arrTemp(LBound(buf) To UBound(buf), LBound(buf, 2) To UBound(buf,=
2))
For i = 1 To UBound(buf)
K = 0
For j = UBound(buf, 2) To 1 Step -1
If Not IsEmpty(buf(i, j)) Then
K = K + 1
arrTemp(i, K) = buf(i, j)
End If
Next
Next
CustomTranspose = arrTemp
End Function
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichD
Le #26506314
Bonjour,
Si l'exemple de ce fichier peut t'aider :
https://www.cjoint.com/c/IAvmIcWcJ5H
MichD
Publicité
Poster une réponse
Anonyme