Hola a todos. Deseo hacer una especie de tabla de contenido en un treeview bajo VBA6. Si alguien tiene alguna idea le agradeceria
No se conocen los titulos y no se sabe cuantos niveles habra
1 Hola
1.1 que mas
1.1.1 que tak
2. a2
2.1 a21
2.2 a22
2.3 a23
3 tema3
3.1 tema31
3.2 tema32
3.2.1 tema321
3.2.2 tema322
3.2.3 tema323
Tengo el siguiente codigo pero me ha estado borrando o anexando nivelacion incorrecta o me borra la que ya se introdujo o anexa la nueva a la vieja (ejemplo 2 1.1 A1)
Codigo:
Sub OrderNodesv3(tv As MSComctlLib.TreeView, prefix As String, _
separator As String, _
NodNode As MSComctlLib.Node)
'Dim NodNode As MSComctlLib.Node
Dim Brothers As Long
Dim NodParentsNode As MSComctlLib.Node
Dim straux As String, straux2 As String, Auxarr() As String, TypeAddNew As String
Dim i As Integer
10 Brothers = 1
20 Set NodParentsNode = NodNode
30 If Not NodParentsNode Is Nothing Then
'ir al primer hermano
40 Set NodParentsNode = GotoFirstBrother(tv, NodNode)
'contar el número de hermanos incluyendo al nodo como miembro de la familia
50 Do Until NodParentsNode.Next Is Nothing
60 Brothers = Brothers + 1
70 Set NodParentsNode = NodParentsNode.Next
80 Loop
'
'Set NodParentsNode = GotoFirstBrother(tv)
90 TypeAddNew = PDTActividad.Relacion.Value
Select Case TypeAddNew
Case "Hijo"
Set NodParentsNode = tv.SelectedItem
100 i = 1
110 Do
'If InStr(1, Trim(NodParentsNode.text), PDTActividad.Prefijo & separator, vbTextCompare) = 1 Then
120 If InStr(1, Trim(NodParentsNode.text), PDT.tvTreeView.Tag & separator, vbTextCompare) = 1 Then '06/20
130 NodParentsNode.text = Trim(Mid(NodParentsNode.text, InStr(1, NodParentsNode.text, " ", vbTextCompare), Len(NodParentsNode.text)))
140 End If
150
'straux2 = Mid(NodParentsNode.text, 1, InStr(1, NodParentsNode.text, ".", vbTextCompare) - 1)
straux = "°" & prefix & separator & Right(String(Len(CStr(Brothers)), "0") & i, Len(CStr(Brothers))) & separator ' 06/20
160 NodParentsNode.text = Trim(straux) & " " & Trim(NodParentsNode.text)
170 If Not NodParentsNode.Child Is Nothing Then
Call OrderNodesv3(tv, straux, ".", NodParentsNode.Child)
End If
190 i = i + 1
210 Set NodParentsNode = NodParentsNode.Next
220 Loop Until NodParentsNode Is Nothing
Case "Raíz"
Set NodParentsNode = tv.SelectedItem
i = 1
Do
If InStr(1, Trim(NodParentsNode.text), PDT.tvTreeView.Tag & separator, vbTextCompare) = 1 Then '06/20
NodParentsNode.text = Trim(Mid(NodParentsNode.text, InStr(1, NodParentsNode.text, " ", vbTextCompare), Len(NodParentsNode.text)))
End If
straux = prefix
NodParentsNode.text = Trim(straux) & " " & Trim(NodParentsNode.text)
If Not NodParentsNode.Child Is Nothing Then
Call OrderNodesv3(tv, straux, ".", NodParentsNode.Child)
End If
i = i + 1
Set NodParentsNode = NodParentsNode.Next
Loop Until NodParentsNode Is Nothing
End Select
230 End If
End Sub
