Treeview printing

Adjusted points to 80

Edited text of question

Directly from the form, yes by printing the form but i think it would be better to use a crystal report,
i do it using this method :
i created a table with this field :
arbor : = R (for root), R1 R2 R3 ... (for a label on the first level) ; R11 R12 R21 R22 (for the label of a second level with R1 or R2 as parent) etc...
label : contain the tree text
level : contain the level
place : contain the place on the treeview (1,2,3,4,5...)

make a sql query ordering by place
on the crystal report make a group footer and a group header for the level field and change the layout as you want.
if it doesn't work with the level field then try with the arbor field.

Cedricd, thanks for your answer to my question.

I am aware I can print the form but that will not print all the tree if it has scroll bars and its quiet lengthy.    Using crystal reports sounds like a solution by I was looking at printing the treeview object directly to the printer by either placing it on the clipboard or using someother means.

tried to build your own function to DRAW the tree in the clipboard or in a text file?

here is the code i make to fill in the treeview and fill in the table (after that you will be able to do what you want with it : i think that clipboard solution will harder than with crystal report if you want more explanation about crystal report, ask me).

init the treeview from the table

Sub Init_TRListe(fenetre As Form, tree As TreeView, rs As Recordset)
   
    Dim Save_Key As Integer
    Dim taille, last_level As Integer
    Dim last, last_father As String
   
    With tree
         .LineStyle = tvwRootLines
         .BorderStyle = ccFixedSingle
         .Appearance = cc3D
         .MousePointer = ccDefault
         .ToolTipText = Replace(Select_Caption("Arborescence de l$offre"), "$", "'")
    End With
    last_father = "R"
    last_level = 0
    tree.Nodes.Add , tvwFirst, last_father, Select_Caption("Offre")
   
    If Not rs.EOF Then
       rs.MoveFirst
       While Not rs.EOF
          If Val(rs!Level) > last_level Then
             tree.Nodes.Add last_father, tvwChild, rs!Arbor, rs!Arbor + " - " + rs("L" + Trim(rs!Level))
             last_level = Val(rs!Level)
             last_father = rs!Arbor
          Else
             If Val(rs!Level) <= last_level Then
                cpt = 0
                posi = InStr(1, last_father, ".")
                While posi <> 0 And cpt < Val(rs!Level)
                      cpt = cpt + 1
                      lasts = posi
                      posi = InStr(lasts + 1, last_father, ".")
                Wend
                last_father = Left(last_father, lasts - 1)
                tree.Nodes.Add last_father, tvwChild, rs!Arbor, rs!Arbor + " - " + rs("L" + Trim(rs!Level))
                last_level = rs!Level
                last_father = rs!Arbor
             End If
          End If
          rs.MoveNext
       Wend
      'rs.Close
       With tree
          For i = 1 To .Nodes.Count
              .Nodes(i).EnsureVisible
          Next
          .HideSelection = False
          .LabelEdit = tvwAutomatic
          .Refresh
       End With
       fenetre.Refresh
    End If
   
End Sub

Adding a nodes to the treeview (level limited at 5)

Sub Update_Tree(tree As TreeView, father As String, Code As String, Id As String)
    Dim rs As Recordset
    Dim dernier, last_level As Integer
    Dim last As String
    Dim cle As String
   
    dernier = 1
    While tree.Nodes.Item(dernier).Key <> father
          dernier = dernier + 1
    Wend
    place = Find_Place(father, Id) + 1
    If tree.Nodes.Item(dernier).Children > 0 Then
       last = tree.Nodes.Item(dernier).Child.LastSibling.Key
       posi = InStr(1, last, ".")
       While posi <> 0
             posa = posi
             posi = InStr(posi + 1, last, ".")
       Wend
       last = Left(last, posa) + Trim(Str(Val(Right(last, Len(last) - posa)) + 1))
    Else
       last = father + ".1"
    End If
    tree.Nodes.Add father, tvwChild, last, last + " - " + Code
    last_level = 0
    dernier = InStr(1, last, ".")
    While dernier <> 0
          last_level = last_level + 1
          dernier = InStr(dernier + 1, last, ".")
    Wend
    tree.Refresh
    dernier = place - 1
    If last_level < 6 Then
       cle = Update_Entete(Code, Id, Str(last_level))
       Set rs = db.OpenRecordset("Select * from " + ENTTE + " Where offre = '" + Id + "' order by place", dbOpenDynaset)
       rs.FindFirst ("place = " + Str(place))
       If Not rs.NoMatch Then
              While Not rs.EOF
                    rs.Edit
                    rs!place = rs!place + 1
                    rs.Update
                    rs.MoveNext
              Wend
       End If
       rs.Close
       Set rs = db.OpenRecordset("Select * from " + ENTTE + " where entetes = " + cle, dbOpenDynaset)
       rs.Edit
       rs!Arbor = last
       rs!place = place
       rs.Update
       rs.Close
    Else
       rc = MsgBox(Replace(Select_Caption("Vous ne pouvez plus ajouter d$en-tjtes !"), "$", "'"), vbInformation)
       dernier = 1
       While tree.Nodes.Item(dernier).Key <> last
             dernier = dernier + 1
       Wend
       tree.Nodes.Remove (dernier)
    End If
End Sub

Adding to the table

Function Update_Entete(Entetes As String, Id As String, Level As String) As String
    Dim rs As Recordset
    Dim cle As String
   
    On Error GoTo Err_UpdateEnt
    Set rs = db.OpenRecordset("Select * from " + ENTTE + " order by entetes", dbOpenDynaset, 0, dbPessimistic)
    If Not rs.EOF Then
       rs.MoveLast
       cle = rs!Entetes + 1
       rs.FindFirst "offre = '" + Id + "'"
    Else
       Level = "1"
       cle = 1
    End If
    rs.AddNew
    rs!Entetes = cle
    rs!Level = Trim(Level)
    rs("l" + Trim(Level)) = Entetes
    rs!offre = Id
    rs.Update
    rs.Close
    Update_Entete = cle
    Exit Function
Err_UpdateEnt:
    rc = MsgBox(Err.Description, vbCritical)
    On Error Resume Next
    rs.Close
    Update_Entete = ""
End Function


delete a node

    If Not Error Then
       If TreeView1.SelectedItem.Children = 0 And TreeView1.SelectedItem.Key <> "R" Then
          rc = MsgBox(Select_Caption("Attention, toutes les lignes correspondant ` cet en-tjte seront supprimies !"), vbOKCancel)
          If rc = vbOK Then
             Call Supp_Entetes(TreeView1, TreeView1.SelectedItem.Key, Id.Text)
             TreeView1.Nodes.Remove (1)
             Set rs = db.OpenRecordset("Select * from " + ENTTE + " Where offre = '" + Id.Text + "' order by place", dbOpenDynaset)
             Call ReArbor(Id.Text)
             Call Init_TRListe(Me, TreeView1, rs)
             rs.Close
             rc = MsgBox(Select_Caption("En-tjte supprimi !"), vbInformation)
          End If
       Else
          If TreeView1.SelectedItem.Key <> "R" Then
             rc = MsgBox(Replace(Select_Caption("Vous devez d$abord supprimer les sous en-tjtes !"), "$", "'"), vbInformation)
          End If
       End If
    End If


Sub ReArbor(Id As String)
    Dim rs As Recordset
    Dim Save_Key() As Integer
    Dim taille, last_level As Integer
    Dim last, last_father As String
   
    last = "R"
    last_level = 0
    taille = last_level + 1
    ReDim Save_Key(taille)
    Save_Key(taille) = 0
    Set rs = db.OpenRecordset("Select * from " + ENTTE + " Where offre = '" + Id + "' order by place", dbOpenDynaset)
    If Not rs.EOF Then
       rs.MoveFirst
       While Not rs.EOF
             Select Case Val(rs!Level)
                    Case Is = last_level
                         Save_Key(last_level) = Save_Key(last_level) + 1
                         last = last_father + "." + Trim(Str(Save_Key(last_level)))
                    Case Is > last_level
                         last_level = Val(rs!Level)
                         If last_level > taille Then
                            taille = last_level
                            ReDim Preserve Save_Key(taille)
                         End If
                         Save_Key(last_level) = 1
                         last_father = last
                         last = last_father + "." + Trim(Str(Save_Key(last_level)))
                    Case Is < last_level
                         cpt = 0
                         posi = InStr(1, last_father, ".")
                         While posi <> 0 And cpt < Val(rs!Level)
                               posa = posi
                               cpt = cpt + 1
                               posi = InStr(posi + 1, last_father, ".")
                         Wend
                         last_father = Left(last_father, posa - 1)
                         last_level = rs!Level
                         Save_Key(last_level) = Save_Key(last_level) + 1
                         last = last_father + "." + Trim(Save_Key(last_level))
             End Select
             With rs
                  .Edit
                  !Arbor = last
                  .Update
                  .MoveNext
             End With
       Wend
    End If
    rs.Close
End Sub

after that you can make a crystal report with this table

here is the code i make to fill in the treeview and fill in the table (after that you will be able to do what you want with it : i think that clipboard solution will harder than with crystal report if you want more explanation about crystal report, ask me).

init the treeview from the table

Sub Init_TRListe(fenetre As Form, tree As TreeView, rs As Recordset)
   
    Dim Save_Key As Integer
    Dim taille, last_level As Integer
    Dim last, last_father As String
   
    With tree
         .LineStyle = tvwRootLines
         .BorderStyle = ccFixedSingle
         .Appearance = cc3D
         .MousePointer = ccDefault
         .ToolTipText = Replace(Select_Caption("Arborescence de l$offre"), "$", "'")
    End With
    last_father = "R"
    last_level = 0
    tree.Nodes.Add , tvwFirst, last_father, Select_Caption("Offre")
   
    If Not rs.EOF Then
       rs.MoveFirst
       While Not rs.EOF
          If Val(rs!Level) > last_level Then
             tree.Nodes.Add last_father, tvwChild, rs!Arbor, rs!Arbor + " - " + rs("L" + Trim(rs!Level))
             last_level = Val(rs!Level)
             last_father = rs!Arbor
          Else
             If Val(rs!Level) <= last_level Then
                cpt = 0
                posi = InStr(1, last_father, ".")
                While posi <> 0 And cpt < Val(rs!Level)
                      cpt = cpt + 1
                      lasts = posi
                      posi = InStr(lasts + 1, last_father, ".")
                Wend
                last_father = Left(last_father, lasts - 1)
                tree.Nodes.Add last_father, tvwChild, rs!Arbor, rs!Arbor + " - " + rs("L" + Trim(rs!Level))
                last_level = rs!Level
                last_father = rs!Arbor
             End If
          End If
          rs.MoveNext
       Wend
      'rs.Close
       With tree
          For i = 1 To .Nodes.Count
              .Nodes(i).EnsureVisible
          Next
          .HideSelection = False
          .LabelEdit = tvwAutomatic
          .Refresh
       End With
       fenetre.Refresh
    End If
   
End Sub

Adding a nodes to the treeview (level limited at 5)

Sub Update_Tree(tree As TreeView, father As String, Code As String, Id As String)
    Dim rs As Recordset
    Dim dernier, last_level As Integer
    Dim last As String
    Dim cle As String
   
    dernier = 1
    While tree.Nodes.Item(dernier).Key <> father
          dernier = dernier + 1
    Wend
    place = Find_Place(father, Id) + 1
    If tree.Nodes.Item(dernier).Children > 0 Then
       last = tree.Nodes.Item(dernier).Child.LastSibling.Key
       posi = InStr(1, last, ".")
       While posi <> 0
             posa = posi
             posi = InStr(posi + 1, last, ".")
       Wend
       last = Left(last, posa) + Trim(Str(Val(Right(last, Len(last) - posa)) + 1))
    Else
       last = father + ".1"
    End If
    tree.Nodes.Add father, tvwChild, last, last + " - " + Code
    last_level = 0
    dernier = InStr(1, last, ".")
    While dernier <> 0
          last_level = last_level + 1
          dernier = InStr(dernier + 1, last, ".")
    Wend
    tree.Refresh
    dernier = place - 1
    If last_level < 6 Then
       cle = Update_Entete(Code, Id, Str(last_level))
       Set rs = db.OpenRecordset("Select * from " + ENTTE + " Where offre = '" + Id + "' order by place", dbOpenDynaset)
       rs.FindFirst ("place = " + Str(place))
       If Not rs.NoMatch Then
              While Not rs.EOF
                    rs.Edit
                    rs!place = rs!place + 1
                    rs.Update
                    rs.MoveNext
              Wend
       End If
       rs.Close
       Set rs = db.OpenRecordset("Select * from " + ENTTE + " where entetes = " + cle, dbOpenDynaset)
       rs.Edit
       rs!Arbor = last
       rs!place = place
       rs.Update
       rs.Close
    Else
       rc = MsgBox(Replace(Select_Caption("Vous ne pouvez plus ajouter d$en-tjtes !"), "$", "'"), vbInformation)
       dernier = 1
       While tree.Nodes.Item(dernier).Key <> last
             dernier = dernier + 1
       Wend
       tree.Nodes.Remove (dernier)
    End If
End Sub

Adding to the table

Function Update_Entete(Entetes As String, Id As String, Level As String) As String
    Dim rs As Recordset
    Dim cle As String
   
    On Error GoTo Err_UpdateEnt
    Set rs = db.OpenRecordset("Select * from " + ENTTE + " order by entetes", dbOpenDynaset, 0, dbPessimistic)
    If Not rs.EOF Then
       rs.MoveLast
       cle = rs!Entetes + 1
       rs.FindFirst "offre = '" + Id + "'"
    Else
       Level = "1"
       cle = 1
    End If
    rs.AddNew
    rs!Entetes = cle
    rs!Level = Trim(Level)
    rs("l" + Trim(Level)) = Entetes
    rs!offre = Id
    rs.Update
    rs.Close
    Update_Entete = cle
    Exit Function
Err_UpdateEnt:
    rc = MsgBox(Err.Description, vbCritical)
    On Error Resume Next
    rs.Close
    Update_Entete = ""
End Function


delete a node

    If Not Error Then
       If TreeView1.SelectedItem.Children = 0 And TreeView1.SelectedItem.Key <> "R" Then
          rc = MsgBox(Select_Caption("Attention, toutes les lignes correspondant ` cet en-tjte seront supprimies !"), vbOKCancel)
          If rc = vbOK Then
             Call Supp_Entetes(TreeView1, TreeView1.SelectedItem.Key, Id.Text)
             TreeView1.Nodes.Remove (1)
             Set rs = db.OpenRecordset("Select * from " + ENTTE + " Where offre = '" + Id.Text + "' order by place", dbOpenDynaset)
             Call ReArbor(Id.Text)
             Call Init_TRListe(Me, TreeView1, rs)
             rs.Close
             rc = MsgBox(Select_Caption("En-tjte supprimi !"), vbInformation)
          End If
       Else
          If TreeView1.SelectedItem.Key <> "R" Then
             rc = MsgBox(Replace(Select_Caption("Vous devez d$abord supprimer les sous en-tjtes !"), "$", "'"), vbInformation)
          End If
       End If
    End If


Sub ReArbor(Id As String)
    Dim rs As Recordset
    Dim Save_Key() As Integer
    Dim taille, last_level As Integer
    Dim last, last_father As String
   
    last = "R"
    last_level = 0
    taille = last_level + 1
    ReDim Save_Key(taille)
    Save_Key(taille) = 0
    Set rs = db.OpenRecordset("Select * from " + ENTTE + " Where offre = '" + Id + "' order by place", dbOpenDynaset)
    If Not rs.EOF Then
       rs.MoveFirst
       While Not rs.EOF
             Select Case Val(rs!Level)
                    Case Is = last_level
                         Save_Key(last_level) = Save_Key(last_level) + 1
                         last = last_father + "." + Trim(Str(Save_Key(last_level)))
                    Case Is > last_level
                         last_level = Val(rs!Level)
                         If last_level > taille Then
                            taille = last_level
                            ReDim Preserve Save_Key(taille)
                         End If
                         Save_Key(last_level) = 1
                         last_father = last
                         last = last_father + "." + Trim(Str(Save_Key(last_level)))
                    Case Is < last_level
                         cpt = 0
                         posi = InStr(1, last_father, ".")
                         While posi <> 0 And cpt < Val(rs!Level)
                               posa = posi
                               cpt = cpt + 1
                               posi = InStr(posi + 1, last_father, ".")
                         Wend
                         last_father = Left(last_father, posa - 1)
                         last_level = rs!Level
                         Save_Key(last_level) = Save_Key(last_level) + 1
                         last = last_father + "." + Trim(Save_Key(last_level))
             End Select
             With rs
                  .Edit
                  !Arbor = last
                  .Update
                  .MoveNext
             End With
       Wend
    End If
    rs.Close
End Sub

after that you can make a crystal report with this table

Cedricd thanks for the code, it looks involved but I will try it,  If its not much trouble, I wouldnt mind some info on the crystal report formating.


Thanks

there's two solution to make a crystal report,
first using the program crystal report (in vb's menu, click on add-ins,report designer)
or by the code :

put a crystal control on your form and a button (or a menu) to print the crystal report
link the crystal control to a data control.
link the data control to your database and data control.recordsource = sql (select * from table in example).
call the following function with this parameter :

tree_report.rpt,sql,crystal1,crptTofile
(reportsource = datacontrol)
after, open the report created and change the lay-out

print the report to a printer (change the last parameter : crpttowindows for a preview or crpttoprinter to print directly on the printer).
(report source =crptreport)

Function Print_Report(Fichier As String, sql As String, Crystal As Control, dest As Integer) As Boolean
       Crystal.SQLQuery = sql
       Crystal.ReportSource = crptReport
       Crystal.PrintFileType = crptCrystal
       Crystal.PrintFileName = App.Path + "\Reports\" + Fichier
       Crystal.ReportFileName = App.Path + "\Reports\" + Fichier
       Crystal.Destination = dest
       Crystal.PrintReport
       Crystal.SQLQuery = ""
       Print_Report = True
End Function

Thanks for you help, but there must be a way of doing a treeview print in some way.  I will leave the question open and see if I can get some solution other then writting the data to a table and them simulating the print in Crystal.  Many thanks

How about formatting the tree into HTML ?
See www.salesforceone.com/tzone/Websales/ for an example.
If this is what your looking for, I can help you with the code.

Bear454,
I had a look at www.salesforceone.com/tzone/Websales and printed the tree which was bigger then the screen size and all of the tree as printed. This is exactly what I want to achieve.  Will it be easy to format the tree in HTML without much change VB, my knowledge of HTML is very basic.  Please if possible guide me through the process and provide me with the code required.  

Thanking you for your help