je cherche à effectuer une copie d'un treeview dans excel ...

[biloute]

Bonjour à tous, je bloque actuellement sur un problème de copie de treeview dans Excel ... je veux copier mon arborescence qui est énorme pour certains cas pour que les utilisateurs aient plus facile à l'étudier ...

Le truc c'est que je fais sous Access un treeview rempli dynamiquement ( par des requêtes and co, appels récursifs bref énorme ....), mais le "hic" c'est qu'un node n'a pas de position x, y ce qui serait idéal pour moi ...

donc si quelqu'un avait une solution ... en fait j'aimerais avoir pour un node sa ligne et sa colonne ... je sais pas si je suis très clair ...

 

[michel]

Bonjour Biloute

je ne suis pas sur que cela corresponde exactement à ta demande mais tu peux essayer cette macro pour afficher l'architecture d'un treeView dans une feuille Excel


Private Sub CommandButton1_Click()
'afficher l'architecture d'un Treeview dans une feuille Excel
Dim i As Integer
Dim Tableau() As Variant

ReDim Tableau(TreeView1.Nodes.Count, 3)

For i = 1 To TreeView1.Nodes.Count
Tableau(i - 1, 0) = TreeView1.Nodes(i).Index
Tableau(i - 1, 1) = TreeView1.Nodes(i).Key
Tableau(i - 1, 2) = TreeView1.Nodes(i).Text
Next i

Range("A1:" & Cells(TreeView1.Nodes.Count, 3).Address) = Tableau()

End Sub


bonne journée
MichelXld

 

[biloute]

Merci Ô grand gourou de l'excel ^^ ...

J'essaie de suite et te redis si ca marche ...

( C'est vraiment le truc qui me bloque pour avancer ... )

 

[biloute]

re michel ...

ca copie bien l'arbre ... mais ce que je voudrai c'est que ca me garde l'arborescence comme visible dans le treeview ...

car affiché comme tu me montres ca ne parle pas du tout au user ...

je viens de penser à quelque chose ...

est-il possible de créer directement la hiérarchie ( le treeview ) dans la page Excel ?

car si j'arrive pas à copier mon treeview comme je veux au pire je réexecute mon prog pour recopier dans une feuille excel ... car j'ai des résultats énormes ... au point de me demander si j'aurai assez de place dans les feuilles excel dans certains cas ...

 

[michel]

rebonjour Biloute

effectivement je vois ce que tu souhaites obtenir

quelle méthode utilises tu actuellement pour alimenter ton TreeView . cela pourrait etre une bonne base de travail pour essayer de la transposer dans une feuille Excel

quand tu dis énorme , cela représente combien d'index ?


bonne journée
MichelXld

 

[biloute]

Bon j'ose faire un copié/collé de mon code Access même si je sais que l'on est sur un forum dédié à Excel ...

donc ma création d'arbre est basée sur une fonction récursive qui utilise des requetes dans access qui dépendent les unes des autres

Michel: j'ai peut etre exagéré sur le nombre ... je pense au max j'ai 1500-2000 noeuds dans mon arbre ...


'********************************************************
'* fonction de recopie de l'arbre dans excel ...
'********************************************************


Private Sub Commande26_Click()

'afficher l'architecture d'un Treeview dans une feuille Excel

Dim arbre As TreeView
Dim i As Integer
Dim Tableau() As Variant
Dim Xcel As Excel.Application
Dim classeur As Excel.Workbook
Dim feuille As Excel.Worksheet
Dim chemin As String

chemin = CurrentProject.path
Set arbre = Me!tree.Object

Set Xcel = CreateObject("Excel.Application")
Set classeur = Xcel.Workbooks.Open(chemin & "fic.xls", ReadOnly:=False)

ReDim Tableau(arbre.Nodes.Count, 3)

For i = 1 To arbre.Nodes.Count
Tableau(i - 1, 0) = arbre.Nodes(i).Index
Tableau(i - 1, 1) = arbre.Nodes(i).Key
Tableau(i - 1, 2) = arbre.Nodes(i).Text
Next i

classeur.Sheets("sheet1").Range("A1:" & Cells(arbre.Nodes.Count, 3).Address) = Tableau()

classeur.Save
classeur.Close

End Sub


'********************************************************
'* remplissage de l'arbre ...
'********************************************************
Function DetailMontage(montageOri As String, objNode As Node, lstMontages() As Variant _
, lstSousEns() As Variant, lstPtus() As Variant, idDb As DAO.Database, arbre As TreeView _
, i As Long, j As Long, k As Long, l As Long)

On Error GoTo erreurFct

Dim clients, montages, res, compoToptu, ptuTocomposant, compoTomontage As DAO.Recordset
Dim libListeMontages, libListePtus, libListeSousEns As String

'** liste contenant les montages, ptus et sous ensemble
' a ne pas réintérroger lors de la boucle ... **


'****************Maj liste de montages ******************
ReDim Preserve lstMontages(UboundEX(lstMontages) + 1)
lstMontages(UboundEX(lstMontages) - 1) = montageOri
libListeMontages = ListingDeTableau(lstMontages)

Set res = idDb.OpenRecordset("SELECT numPiece FROM [%piece%montage] " _
& "where numMontage = '" & montageOri & "' and numPiece not in ('" & libListeSousEns & "')")

While Not res.EOF

'**************** Maj liste des sous/ens *****************
ReDim Preserve lstSousEns(UboundEX(lstSousEns) + 1)
lstSousEns(UboundEX(lstSousEns) - 1) = res!numPiece
libListeSousEns = ListingDeTableau(lstSousEns)

arbre.Nodes.Add "MontageNo_" & montageOri, tvwChild, "SousEnsNo_" & j, j & " - " & res!numPiece
arbre.Nodes("SousEnsNo_" & j).BackColor = 16744448

Set compoToptu = idDb.OpenRecordset("SELECT noProduit FROM RESULT_RQ_DECOMPO_INVERSE " _
& " WHERE noComposant= '" & res!numPiece & "' and noProduit not in ('" & libListePtus & "') ")

While Not compoToptu.EOF
DoEvents

'If EltDansListe(compoToptu!noProduit, lstPtus) = False Then

'****************Maj liste des ptus ********************
ReDim Preserve lstPtus(UboundEX(lstPtus) + 1)
lstPtus(UboundEX(lstPtus) - 1) = compoToptu!noProduit
libListePtus = ListingDeTableau(lstPtus)

arbre.Nodes.Add "SousEnsNo_" & j, tvwChild, "PtuNo_" & k, k & " - " & compoToptu!noProduit
arbre.Nodes("PtuNo_" & k).BackColor = RGB(255, 255, 128)

Set ptuTocomposant = idDb.OpenRecordset("SELECT noComposant FROM RESULT_RQ_DECOMPO " _
& " WHERE noProduit= '" & compoToptu!noProduit & "' and noComposant not in ('" & libListeSousEns & "') ")

'Else

' arbre.Nodes.Add "SousEnsNo_" & j, tvwChild, "_PtuNo_" & k, compoToptu!noProduit & " - " & "res" & j
' arbre.Nodes("_PtuNo_" & k).BackColor = RGB(0, 0, 0)
' arbre.Nodes("_PtuNo_" & k).ForeColor = RGB(255, 255, 128)

'End If

While Not ptuTocomposant.EOF
DoEvents

'If EltDansListe(ptuTocomposant!NoComposant, lstSousEns) = False Then

'**************** Maj liste des sous/ens *****************
ReDim Preserve lstSousEns(UboundEX(lstSousEns) + 1)
lstSousEns(UboundEX(lstSousEns) - 1) = ptuTocomposant!NoComposant
libListeSousEns = ListingDeTableau(lstSousEns)
'***************************************************

arbre.Nodes.Add "PtuNo_" & k, tvwChild, "NoSousEnsBis_" & l, l & " - " & ptuTocomposant!NoComposant
arbre.Nodes("NoSousEnsBis_" & l).BackColor = 16744448

Set compoTomontage = idDb.OpenRecordset("SELECT montage.numMontage,montage.designMontage FROM [%piece%montage],montage " _
& "where numPiece = '" & ptuTocomposant!NoComposant & "' and [%piece%montage].numMontage not in ('" & libListeMontages & "') and [%piece%montage].numMontage=montage.numMontage")

'Else

' arbre.Nodes.Add "PtuNo_" & k, tvwChild, "_NoSousEnsBis_" & l, l & " - " & ptuTocomposant!NoComposant
' arbre.Nodes("_NoSousEnsBis_" & k).ForeColor = RGB(255, 255, 128)
'arbre.Nodes("_NoSousEnsBis_" & l).BackColor = 16744448

'End If

While Not compoTomontage.EOF
DoEvents

'arbre.Nodes.Add "decompo" & l, tvwChild, "Mont_" & compoTomontage!numMontage, compoTomontage!numMontage & " - " & "decompo" & l & " - " & i

If EltDansListe(compoTomontage!numMontage, lstMontages) = False Then

arbre.Nodes.Add "NoSousEnsBis_" & l, tvwChild, "MontageNo_" & compoTomontage!numMontage, compoTomontage!numMontage & " - " & compoTomontage!designMontage
arbre.Nodes("MontageNo_" & compoTomontage!numMontage).BackColor = RGB(0, 0, 0)
arbre.Nodes("MontageNo_" & compoTomontage!numMontage).ForeColor = RGB(255, 255, 255)
Call DetailMontage(compoTomontage!numMontage, arbre.Nodes("MontageNo_" & compoTomontage!numMontage), _
lstMontages, lstSousEns, lstPtus, idDb, arbre, i + 1, j + 1, k + 1, l + 1)

Else

arbre.Nodes.Add "NoSousEnsBis_" & l, tvwChild, "_MontageNo_" & compoTomontage!numMontage, compoTomontage!numMontage & " - " & compoTomontage!designMontage
arbre.Nodes("_MontageNo_" & compoTomontage!numMontage).ForeColor = RGB(0, 0, 0)
arbre.Nodes("_MontageNo_" & compoTomontage!numMontage).BackColor = RGB(255, 255, 255)

End If

i = i + 1
compoTomontage.MoveNext

Wend

compoTomontage.Close
ptuTocomposant.MoveNext
l = l + 1

Wend

ptuTocomposant.Close
compoToptu.MoveNext
k = k + 1

Wend

compoToptu.Close
res.MoveNext
j = j + 1

Wend

res.Close

erreurFct:
'
'MsgBox montageOri
'MsgBox Err.Description
Resume Next

End Function

 

[michel]

rebonjour Biloute

est ce que tu peux tester cette nouvelle version , qui j'espere répondra mieux à ta demande


'variable Public à placer tout en haut de la macro
Public Ligne As Integer

Private Sub CommandButton2_Click()
'adapté de la source :
'http://www.vb-helper.com/howto_treeview_load_edit_save.html

If TreeView1.Nodes.Count > 0 Then SaveNode TreeView1.Nodes(1), 1

End Sub


Private Sub SaveNode(ByVal n As Node, ByVal Level As Integer)
If n Is Nothing Then Exit Sub

Ligne = Ligne + 1
Cells(Ligne, Level) = n.Text
SaveNode n.Child, Level + 1
SaveNode n.Next, Level

End Sub


bon après midi
MichelXld

 

[michel]

oouuppsss…nos messages se sont croisés

très impressionnant ta macro …je vais faire comme si je ne l'avais pas vu …;o) ...en attendant que tu ne testes la macro de mon dernier message


bon après midi
MichelXld

 

[biloute]

MERCIIIIIIIIIIIII !!!!


c pas IMPECCABLE !! c 2 PECCABLE !!!

exactement ce que je cherchais ... et le tout tient en pas beaucoup de code quand tu regardes >.> ...

bref ... je te suis vraiment reconnaissant !!

ma macro impressionnante me prend d'ailleurs bien la tête ... car elle est pas très au point ... bref après c'est juste une question de pauffinage ...

bref ^^ encore merci !!!