Office: (Office 2010) TreeView umstricken

Nakoda · 16. Juni 2017

nabend nouba,

läuft nun hier ebenfalls.
Habe noch mal alles geprüft. auch die Eigenschaften.
Das late binding war nicht gespeichert.

Nun haben wir einen fixen Baum.
Der ändert sich ja aber ständig weil ja auch immer neue Einkaufswagen dazu kommen.
Da dachte ich das man die tblLinear1 aus meinem Beispiel anhand einer Abfrage füllen könnte um Damit den Baum zu erstellen.

Nouba · 16. Juni 2017

Amin, das geht relativ analog zu dem von mir bisher gezeigtem Code. Eine Abfrage mit Namen data (solltest Du an Deine Gegebenheit anpassen) sollte mit diesem Code den Baum füllen. Code:

Option Compare Database
Option Explicit

' tvBelege: Name des Treeview-Steuerelements im Formular
'
' oder in den VBA-Projekteigenschaften unter
' Argumente für bedingte Kompilierung setzen
#Const Test = 0
#Const LateBinding = 1
#Const Data = 1

#If LateBinding Then
Private Const ccFlat As Long = 0
Private Const ccNone As Long = 0
Private Const tvwRootLines As Long = 1
Private Const tvwChild As Long = 4
Private Const tvwTreelinesPlusMinusText As Long = 6

Private Const dbOpenSnapshot As Long = 4
Private Const dbForwardOnly As Long = 256
#End If

#If Test Then
Private Const Data As String = _
"Einkaufswagen01" & vbCrLf & _
"Einkaufswagen01; Folgebeleg01" & vbCrLf & _
"Einkaufswagen01; Folgebeleg01; Position01" & vbCrLf & _
"Einkaufswagen01; Folgebeleg01; Position02" & vbCrLf & _
"Einkaufswagen01; Folgebeleg01; Position03" & vbCrLf & _
"Einkaufswagen02" & vbCrLf & _
"Einkaufswagen02; Folgebeleg02" & vbCrLf & _
"Einkaufswagen02; Folgebeleg02; Position01" & vbCrLf & _
"Einkaufswagen02; Folgebeleg02; Position02" & vbCrLf & _
"Einkaufswagen02; Folgebeleg02; Position03" & vbCrLf & _
"Einkaufswagen02; Folgebeleg02; Position04" & vbCrLf & _
"Einkaufswagen02; Folgebeleg02; Position05" & vbCrLf & _
"Einkaufswagen03" & vbCrLf & _
"Einkaufswagen03; Folgebeleg03" & vbCrLf & _
"Einkaufswagen03; Folgebeleg03; Position01" & vbCrLf & _
"Einkaufswagen03; Folgebeleg03; Position02" & vbCrLf & _
"Einkaufswagen03; Folgebeleg04; Position01" & vbCrLf & _
"Einkaufswagen03; Folgebeleg04; Position02" & vbCrLf & _
"Einkaufswagen03; Folgebeleg04; Position03" & vbCrLf & _
"Einkaufswagen03; Folgebeleg04; Position04"
#End If

Private Sub Form_Load()
With tvBelege.Object
.Appearance = ccFlat
.BorderStyle = ccNone
.Checkboxes = False
.LineStyle = tvwRootLines
.PathSeparator = ""
.Style = tvwTreelinesPlusMinusText
With .Font
.Name = "Calibri"
.Size = 11
.Bold = True
End With
End With

#If Test Then
Dim Lines() As String, i As Long
Lines = Split(Replace(Data, "; ", ""), vbCrLf)
For i = 0 To UBound(Lines): AddNodesFromPath tvBelege.Object, Lines(i): Next
#End If

#If Data Then
Dim Rs As Object

Set Rs = CurrentDb().OpenRecordset("data", dbOpenSnapshot, dbForwardOnly)
AddNodesFromRecordset tvBelege.Object, Rs
Rs.Close
#End If

End Sub

Private Sub AddNodesFromRecordset(Tree As Object, Rs As Object)
Dim Sep As String, OldPath As String, i As Long

Sep = Tree.PathSeparator

Do Until Rs.EOF
For i = 0 To Rs.Fields.Count - 1
With Tree.Nodes
On Error Resume Next ' weil Pfade wiederholt vorkommen (können)
Select Case i
Case 0: .Add , , Sep & Rs(i), Rs(i)
Case Else: .Add OldPath, tvwChild, OldPath & Sep & Rs(i), Rs(i)
End Select
On Error GoTo 0
End With
OldPath = OldPath & Sep & Rs(i)
Next
Rs.MoveNext
Loop
End Sub

Private Sub AddNodesFromPath(Tree As Object, PathElement As String)
Dim Items() As String, OldPath As String, Sep As String, i As Long

Items = Split(PathElement, Tree.PathSeparator)
Sep = Tree.PathSeparator

For i = 0 To UBound(Items)
With Tree.Nodes
On Error Resume Next ' weil Pfade wiederholt vorkommen (können)
Select Case i
Case 0: .Add , , Sep & Items(i), Items(i)
Case Else: .Add OldPath, tvwChild, OldPath & Sep & Items(i), Items(i)
End Select
On Error GoTo 0
End With
OldPath = OldPath & Sep & Items(i)
Next
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Die Änderungen sind grün markiert.

Nakoda · 17. Juni 2017

Was würde ich bloß ohne Euch hier machen.

Habs nun in meine DB eingebaut und auch die Eigenschaften
angepasst.

Dann hab ich mir eine Abfrage "data" gebastelt. Code:

SELECT tblorders.cartnumber,
tblorders.supplierordernumber,
tblarticles.articlename
FROM tblorders
INNER JOIN (tblarticles
INNER JOIN tblorderdetails
ON tblarticles.articleid = tblorderdetails.articleid)
ON tblorders.orderid = tblorderdetails.orderid
ORDER BY tblorders.cartnumber;
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ergebnis siehe Anhänge.
Zu Erklärung, wenn ein Einkaufswagen abgelehnt oder stoniert wird dann bekommt er keine SupplierOrderNumber. Daher die Löcher.
Leider bleibt der Kasten leer

Nouba · 17. Juni 2017

Mein Fehler. Füge direkt nach oder direkt vor Rs.MoveNext eine Zeile mit OldPath = vbNullString ein. In der Abfrage solltest Du dann mittels Nz-Funktion einen Dummy-Wert für die Datensätze ohne vorhandene SupplierOrderNumber festlegen.

Nakoda · 17. Juni 2017

Hmmm! Taaade.
Klappt nich.
Soll ich mal meine Version hoch schieben?
Oder per PN.
Hatte zunächst alle leeren rausgelassen.

Nouba · 17. Juni 2017

Ich bin gespannt auf die Ursache. *Smilie

Nakoda · 17. Juni 2017

Und ich man erst.
Bestimmt ein 80cm Problem. *grins *entsetzt

Nakoda · 17. Juni 2017

Abfrage angepasst und diesmal alles leere nicht rausgenommen sondern mit Nz gefüllt.

Nakoda · 17. Juni 2017

Da bin ich auch schon wieder. *biggrin.gif*
Da hatte ich in einem alten "Machwerk" schon mal ne TreeView gebaut.
Doof wie ich bin auch da mit Hilfe.
Das war irgendwann 2007 oder eher.
Baum is ja schön und gut.
Da dachte ich könnte meinen alten Code übernehmen.
Nix da. Damals hatte ich für jeden Zweig ne eigene Abfrage und da hab ich dann über eine Select Case auf die jeweiligen Formulare zu gegriffen.
Schein ja jetzt wohl "büschn" anders zu laufen.
Was muss ich denn machen wenn ich auf nen Knoten klicke mir die Anzeige angepasst wird.
Will sagen als Standard eben alle Einkaufswagen (EKW) angezeigt.
Bei Klick auf EKW sollen dann alle "son" in einem UFo angezeigt werden und bei Klick auf eine "son" dann alle Artikel und bei Klick auf Artikel dann eben alle Details zu diesem Artikel. Code:

Public Sub m_objtv_NodeClick(ByVal Node As MSComctlLib.Node)
Dim strSfr As String
Dim strFilter As String

Select Case Left$(Node.Key, 2)
Case "AL"
strSfr = "sfrEmpsDatasheet"
Case "SI"
strSfr = "sfrEmpsDatasheet"
strFilter = "SIGLUM = '" & Mid(Node.Key, 3) & "'"
Case "SE"
strSfr = "sfrEmpsDatasheet"
strFilter = "SISE = '" & Mid(Node.Key, 3) & "'"
Case "EM"
strSfr = "sfrSingleEmp"
strFilter = "EmpID = " & Mid(Node.Key, 3)
End Select
With Me!sfrEmpDetails
If .SourceObject strSfr Then
.SourceObject = strSfr
End If
With .Form
If Len(strFilter) Then
.Filter = strFilter
.FilterOn = True
Else
.FilterOn = False
End If
End With
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Nouba · 17. Juni 2017

Du solltest einmal den Objektkatalog öffnen und Dir die Eigenschaften der betroffenen Objekte ansehen - dann wird man auch in die Lage versetzt, selbstständig mit den Objekten umgehen zu können (das ist nämlich keine Hexerei).

Eine mögliche Vorgehensweise in der NodeClick-Prozedur könntest Du hieraus ableten. Code:

Dim Fields() As String

Fields = Split(Node.FullPath, Me.tvBelege.Object.PathSeparator)
Select Case UBound(Fields)
Case 0: 'Es wurde ein EKW angeklickt
'in Fields(0) steht der Text des EKW
Case 1: 'Es wurde eine SON angeklickt
'in Fields(0) steht der Text des EKW
'in Fields(1) steht der Text der SON bzw. deren Ersatzwert für Null
Case 2: 'Es wurde ein AN angeklickt
'in Fields(0) steht der Text des EKW
'in Fields(1) steht der Text der SON bzw. deren Ersatzwert für Null
'in Fields(2) steht der Text zu AN
End Select
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Nakoda · 17. Juni 2017

Moinsen,

Nachricht ist angekommen und ich gelobe Besserung.
Hab im Moment nur ein kleines Zeitproblem.
Ist zwar keine Entschuldigung aber zumindest eine Erklärung. *biggrin.gif*
Schönen Sonntag für Dich.

Nakoda · 28. Juni 2017

Nabend zusammen,

ich würde hier gerne noch einmal einhaken.
Hab nun soweit alles zusammen und es funktioniert auch alles prima.
Nur eine Winzigkeit hätte ich da noch.
Das Ganze ist arg langsam.
Ich habe ca. 500 Reihen in der Datenbasis.
Der Aufbau des Baumes nimmt etwa 10 Sek+ in Anspruch.
Ich nehme an das wird sich potenzieren wenn es mehr Knoten zu bilden gibt.
Mag es daran liegen das es immer wieder vorkommt das ein Schlüssel nicht
einzigartig ist?
Auch das schließen des Formulares dauert sehr lange.

thomas@pfoch.de · 28. Juni 2017

...ich traue mich ja gar nicht, es hier reinzuschreiben, weil es sehr nach Spam klingt - aber googlet doch bitte mal nach 'picoware' und 'Treeview' und schaut euch die Demo an - vielleicht wäre das ja eine Lösung.

VG Thomas Pfoch

markusxy · 7. Januar 2021

von thomas@pfoch.de

...ich traue mich ja gar nicht, es hier reinzuschreiben, weil es sehr nach Spam klingt - aber googlet doch bitte mal nach 'picoware' und 'Treeview' und schaut euch die Demo an - vielleicht wäre das ja eine Lösung.

VG Thomas Pfoch
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Vielleicht kannst du uns ja auch sagen, ob dieses Produkt vom Bildaufbau wahrnehmbar schneller ist wie die VB6 Komponente. Weil für die anderen Bremsen ist der TS ja selbst verantwortlich.

LG M

Nakoda · 29. Juni 2017

Nabend!
Hab mal reingeschaut.
Sieht ja ganz anständig aus.
300 Schleifen ist aber ein ganz schöner Batzen.
Außerdem hat Markus recht.
Ist der wirklich schneller?

Office: (Office 2010) TreeView umstricken

TreeView umstricken

TreeView umstricken

TreeView umstricken

TreeView umstricken

TreeView umstricken

TreeView umstricken - Similar Threads - TreeView umstricken

Listenfeld per Doppel Klick in Treeview füllen

Treeview... suche Tipps, Literatur, Beispiele & Erklärungen

TreeView-Alternative mit MS-Bordmitteln

Treeview funktioniert nicht mehr ( nicht registriert)

TreeView

TreeView-Steuerelement mit einer großen Anzahl von Knoten bewirkt eine Ausnahme in Access

Treeview in Excel 2013 32bit nicht verfügbar?