Excel - TOC

 
Vista:

TOC

Publicado por alberto (1 intervención) el 25/06/2012 16:05:14
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 este pedazo de codigo pero me borra o me anexa nivelacion que no deseo


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

Gracias
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder