Bonjour

C'est ma première participation, merci d'être indulgent

Comme beaucoup, j'ai été confronté au problème de l'impression d'un treeView alors que je ne dispose pas de VB6.olb pour gérer l'objet PRINTER :
http://access.developpez.com/faq/?page=TreeView

Voici un bout de code permettant de redessiner un état identique au TreeView affiché. Il faut créer au préalable un état "ETreeView" vide.
Une fois redessiné, cet état peut être intégré à un état principal permettant d'affiché le titre, ....

La fonction donne également la possibilité de scruter et donc d'imprimer le TreeView qu'à partir de l'élément sélectionner (2ème argument facultatif). Un état étant limité par Access à 140 éléments.

Il y a certainement des choses à améliorer comme la gestion d'erreur.

Cordialement

L'appel se fait comme suit :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
Call ImprimeTreeView(Me.TV.Object, Me.TV.SelectedItem)
La fonction à déposer dans un module :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
' Creer un état vide ETreeView (portrait et marges réduites <1 cm)
' Pour rappel : 1cm = 567 twips
Private Const Retrait = 300 ' marge gauche entre chaque niveau en twips
Private Const Espacement = 225 ' Espacement des lignes en twips
Private Const EncrageTrait = 100 ' Hauteur entre le coin supérieur du label et le trait en twips
Private Const LargeurEtat = 10773 '567 x 19cm
Dim Ligne As Integer ' Comptage des lignes pour placement du prochain objet
 
Public Function ImprimeTreeView(oTree As TreeView, Optional TVNode As Node, Optional Niveau As Integer = 0)
Dim BrancheLimit As Integer ' Permet de limiter la scrutation à la branche sélectionnée
Dim HautLigne As Integer ' Point de départ du trait vertical
Dim BasLigne As Integer ' Point d'arrivée du trait vertical
 
On Error GoTo Fin:
 
'Initialisation des variables et de l'état
If Niveau = 0 Then
    Ligne = 0
    Niveau = 1
    If TVNode Is Nothing Then
        Set TVNode = oTree.Nodes(1)
    Else
        Set TVNode = oTree.Nodes(TVNode.Key)
        BrancheLimit = 1
    End If
 
    DoCmd.OpenReport "ETreeView", acViewDesign
    ' Effacement des objets de l'état
    Do While Reports![ETreeView].Count > 0
    St = Reports![ETreeView].Controls.Item(0).Name
    DeleteReportControl "ETreeView", St
    Loop
 
    ' Redimensionnement vertical de l'état
    Reports![ETreeView].Section(acDetail).Height = 567
End If
 
'Recherche des éléments du TreeView
HautLigne = Ligne
Do Until TVNode Is Nothing
    Ligne = Ligne + 1
    ' Placement du libélé
    Set tBox = CreateReportControl("EtreeView", acLabel, acDetail, "", TVNode.Text, Retrait * Niveau, Espacement * (Ligne - 1))
 
    With tBox
        .FontSize = 8
        .FontName = "Arial"
        .Height = Espacement
        .Width = LargeurEtat - Retrait * Niveau
        .ForeColor = TVNode.ForeColor
         If TVNode.Bold = True Then .FontWeight = 700
    End With
 
    ' Dessine le trait horizontal
    Set Li = CreateReportControl("ETreeView", acLine, acDetail, , , Retrait * (Niveau - 1), Espacement * (Ligne - 1) + EncrageTrait, Retrait, 0)
    BasLigne = Ligne
 
    ' Recherche des enfants si vue non limitée
    If TVNode.Expanded = True Then
        ImprimeTreeView oTree, TVNode.Child, Niveau + 1
    End If
 
    Set TVNode = TVNode.Next
    If BrancheLimit = 1 Then Exit Do
Loop
 
' traçage du trait vertical
If BasLigne > HautLigne Then
    Set Li = CreateReportControl("ETreeView", acLine, acDetail, , , Retrait * (Niveau - 1), Espacement * HautLigne, 0, Espacement * (BasLigne - HautLigne) - EncrageTrait)
End If
 
If Niveau = 1 Then
    ' Fin de la création de l'état
    Reports![ETreeView].Width = LargeurEtat ' Rétablit la largeur de l'état
    DoCmd.Close acReport, "EtreeView", acSaveYes 'Enregistrement de l'état
 
    ' Affichage
    DoCmd.OpenReport "ETreeView", acViewPreview ' Supprimer ", acViewPreview" pour une impression directe
    Set oTree = Nothing
End If
Exit Function
 
Fin:
A = MsgBox("Nb de lignes : " & Ligne & vbCrLf _
        & "L'état ne peut pas s'afficher correctement, choississez une branche plus courte", _
        vbCritical + vbOKOnly, "Dépassement de capacité") ' Un état est limité à 140 lignes
End Function