MS-Office-Forum
Google
   

Zurück   MS-Office-Forum > Microsoft Access & Datenbanken > Microsoft Access
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads Der Renner, 11 Entwicklertools für Access, Tipps & Trick und offene Datenbanken zum einzigartigen Preis.
Themen-Optionen Ansicht
Alt 15.09.2017, 16:14   #1
chbahn
MOF User
MOF User
Standard Acc2016 - Klassen Formular Zugriff

Was versuche ich:
Ich möchte eine Klasse definieren, bei der ich über Angaben von Werten einen TreeView einfach befüllen und bearbeiten kann.
Das Erstellen der Klasse ist nicht das Problem, sondern wie greife ich vom Formular auf die Klasse zu. Denn das aufrufen der Klasse erfolgt aus einem Modul heraus! Die Definition der Klasse erfolgt also im Modul. Aber wie kann ich aus der Formular auf diese Daten zugreifen, die ich im Modul der Klasse übergeben habe?
Oder kann ich in der Klasse Events definieren die sich auf das Formular beziehen?
Was habe ich bis jetzt?
Eine Klasse wo die wichtigsten Parameter benötigt werden bevor das Formular angezeigt wird! Das Formular wird in eine Variable geladen und anschließen angezeigt! Oder sollte man hier einen anderen Weg gehen?
Hier mein Entwurf der Klasse:
Code:

Option Compare Database

'Aufbau der Tabelle fürs Treeview
' ID (Autowert)
' Key wird Berechnet aus Feld ID und dem String strdbKZ
' ViewName beinhaltet den Wert der im Treeview angezeigt werden soll
' ParentKey veweist auf das Vaterobject

Dim strFormname As String           'Formular Name im Ramen
Dim strdbTable As String            'Name der Tabelle mit den Daten
Dim strdbFieldKey As String         'Feldname des Keys
Dim strdbFieldViewName As String    'Feldname zum Anzeigen im Treeview
Dim strdbParentKey As String        'Feldname des ParentKys
Dim strdbKZ                         'Wert der zum berechnen des Keys benötigt wird!

Dim objForm As Form

Property Let Formname(value As String)
    strFormname = value
End Property

Property Get Formname() As String
    Formname = strFormname
End Property

' Tabellenfunktionen
Property Let dbTable(value As String)
    strdbTable = value
End Property

Property Get dbTable() As String
    dbTable = strdbTable
End Property

Property Let dbFieldKey(value As String)
    strdbFieldKey = value
End Property

Property Get dbFieldKey() As String
    dbFieldKey = strdbFieldKey
End Property

Property Let dbFieldViewName(value As String)
    strdbFieldViewName = value
End Property

Property Get dbFieldViewName() As String
    dbFieldViewName = strdbFieldViewName
End Property

Property Let dbParentKey(value As String)
    strdbParentKey = value
End Property

Property Get dbParentKey() As String
    dbParentKey = strdbParentKey
End Property

Property Let dbKZ(value As String)
    strdbKZ = value
End Property

Property Get dbKZ() As String
    dbKZ = strdbKZ
End Property

Public Sub OpenTreeView()
    readData
End Sub

Public Sub readData()
    If CheckData = True Then
        With objForm
            .Caption = strFormname
            .ViewsAllowed = 1
            .Visible = True
            While CurrentProject.AllForms("FORM_TREEEDIT").IsLoaded = True
                DoEvents
            Wend
        End With
        'DoCmd.OpenForm "FORM_TREEEDIT", acNormal, , , , acDialog
    End If
End Sub

Private Function CheckData() As Boolean
    On Error GoTo CheckData_Error
    'Dim strFormname As String           'Formular Name im Ramen
    
    If Len(strdbTable) = 0 Or IsNull(strdbtabel) = True Then
        Err.Raise 1000 + vbObjectError, "dbTable", "TREEEDIT:Es wurde keine Tabelle angegeben!"
    End If
    If Len(strdbFieldKey) = 0 Or IsNull(strdbFieldKey) = True Then
        Err.Raise 1001 + vbObjectError, "dbTable", "TREEEDIT:Es wurde keine KEY Feld angegeben!"
    End If
    If Len(strdbFieldViewName) = 0 Or IsNull(strdbFieldViewName) = True Then
        Err.Raise 1002 + vbObjectError, "dbFieldViewName", "TREEEDIT:Es wurde keine Anzeigename angegeben!"
    End If
        If Len(strdbParentKey) = 0 Or IsNull(strdbParentKey) = True Then
        Err.Raise 1003 + vbObjectError, "dbParentKey", "TREEEDIT:Es wurde keine Feld ParentKey angegeben!"
    End If
        If Len(strdbKZ) = 0 Or IsNull(strdbKZ) = True Then
        Err.Raise 1004 + vbObjectError, "dbKZ", "TREEEDIT:Es wurde keine Kennzeichen angegeben!"
    End If
CheckData_Exit:
    CheckData = True
    Exit Function
CheckData_Error:
    MsgBox "Fehler-Nummer: " & Err.Number - vbojecterror & vbCrLf & "Fehler-Beschreibung: " & Err.Description, , Err.Source
End Function

Private Sub Class_Initialize()
    Set objForm = New Form_FORM_TREEEDIT
End Sub
Hier das Modul welche die Klasse aufruft:
Code:

Public Sub testtreeview()
    Dim objtree As New CLS_TREEDIT
    With objtree
        .Formname = "Abteilungen bearbeiten"
        .dbTable = "ABTEILUNGEN"
        .dbFieldKey = "ABTEILUNG_KEY"
        .dbFieldViewName = "ABTEILUNG_NAME"
        .dbParentKey = "ABTEILUNG_KEY_PARENT"
        .dbKZ = "ABT"
        .OpenTreeView
    End With
End Sub
Für Anregungen, Hilfestellungen jeder Art bin ich Dankbar.
Christian

__________________

"Programmers never die, they just GOSUB without RETURN"
chbahn ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 15.09.2017, 17:17   #2
Beaker s.a.
MOF Koryphäe
MOF Koryphäe
Standard

Hallo,
Meine spontane Idee als KlassenNeuling, - verwende für objtree eine öffentliche Property.
gruss ekkehard

__________________

--
S.M.I.²L.E.
Beaker s.a. ist gerade online  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 15.09.2017, 18:34   #3
sonic8
MOF Profi
MOF Profi
Standard

Zitat: von chbahn Beitrag anzeigen

...Denn das aufrufen der Klasse erfolgt aus einem Modul heraus! Die Definition der Klasse erfolgt also im Modul. Aber wie kann ich aus der Formular auf diese Daten zugreifen, die ich im Modul der Klasse übergeben habe?
Oder kann ich in der Klasse Events definieren die sich auf das Formular beziehen?

Ich glaub den obigen Teil solltest du nochmal etwas ausführlicher und konkreter beschreiben. Ich werde da nämlich nicht so ganz schlau draus.

Kann das Form eine Abhängigkeit von der Klassen haben? Dann könntest du in dem Form eine Property erstellen, die die Instanz der Klasse referenziert. Damit hättest du im Formular eine Zugriffsmöglichkeit auf die Klasse.
sonic8 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 18.09.2017, 11:05   #4
chbahn
Threadstarter Threadstarter
MOF User
MOF User
Standard

Danke für eure Infos! Werde das mal testen und mich später wieder melden.

__________________

"Programmers never die, they just GOSUB without RETURN"
chbahn ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.11.2017, 12:10   #5
chbahn
Threadstarter Threadstarter
MOF User
MOF User
Standard

So, es ist einige Zeit verstrichen und ich habe dieses Thema schon vergessen, aber ich habe meine Lösung gefunden und möchte diese euch hier zeigen!
Was kann meine Klasse.
Mit dieser Klasse ist es möglich einen Wert aus eine hierarchisch auferbauten Tabelle auszuwählen, oder Werte in dem Treeview bearbeiten. Wird das Treeview im Bearbeitungsmodus geöffnet ist ein Verschieben per Drag & Drop möglich!
Die Klasse benötigt ein Formular mit den entsprechenden Treeview, Eingabefelder und Schaltflächen.


Beispieldatenbank gibt es hier

Beispielcode zum Aufrufen der Klasse:
Code:

Public Sub testtreeview()
    Dim objTree As New CLS_TREEDIT
    With objTree
        .CalcIDType = MaxPlus1
        '.CalcIDSQL = "SELECT MAX(ABTEILUNG_ID)+1 FROM ABTEILUNGEN WHERE CLIENT_ID=2"
        .Formname = "Abteilungen bearbeiten"
        .TreeName = "Abteilungen"
        .dbTable = "ABTEILUNGEN"
        .dbFieldKey = "ABTEILUNG_ID"
        .dbFieldViewName = "ABTEILUNG_NAME"
        .dbParentKey = "ABTEILUNG_ID_PARENT"
        .dbKZ = "ABT"
        .FormType = SelectValue
        
        .AddWhere "CLIENT_ID", "2", Number
        .OpenTreeView
        While .IsActive = True
            DoEvents
        Wend
        Debug.Print .Selected
    End With
End Sub
Hier nur der Quellcode meiner Klasse:
Code:

Option Compare Database

Public Enum FieldTypeValues
    Text = 1
    Number = 2
    DateTime = 3
End Enum

Public Enum FormTypeValues
    EditValues = 1
    SelectValue = 2
End Enum

Public Enum CalcIDTypes
    Autowert = 1
    MaxPlus1 = 2
    SQLString = 3
End Enum

Private Type typeWhere
    Fieldname As String
    FieldValue As Variant
    FieldValueType As FieldTypeValues
End Type

'Aufbau der Tabelle fürs Treeview
' ID (Autowert)
' Key wird Berechnet aus Feld ID und dem String strdbKZ
' ViewName beinhaltet den Wert der im Treeview angezeigt werden soll
' ParentKey veweist auf das Vaterobject

Dim strFormname As String               'Formular Name im Ramen
Dim strdbTable As String                'Name der Tabelle mit den Daten
Dim strdbFieldKey As String             'Feldname des Keys
Dim strdbFieldViewName As String        'Feldname zum Anzeigen im Treeview
Dim strdbParentKey As String            'Feldname des ParentKys
Dim strdbKZ                             'Wert der zum berechnen des Keys benötigt wird!
Dim strTreeName As String               'Angezeigte Name des Root Eintrages vom TreeView
Dim intFormType As Integer              'Wie soll das Formular gehandhabt werden. Auswählen (Default) oder bearbeiten?
Dim strCaptionButtonSelect As String    'Was soll auf der Schaltfläsche zum Auswählen stehen (Default = "&Auswählen")
Dim strCaptionButtonClose As String     'Was soll auf der Schließen Schaltfläsche stehen (Default = "&Schließen")
Dim lngSelectedValue As Long            'Ausgewählter Wert (0 bei Abbrechen)
Dim bitActive As Boolean                'Ist Fenster Aktiv
Dim datWhere() As typeWhere             'Leeres Array um die Where Bedingungen zu speichern
Dim intWhere As Integer                 'Anzahl der Where Felder
Dim intCalcIDType As CalcIDTypes        'Art der ID berechnung. 1=Autowert,2=MAX Id + 1, 3 = SQL
Dim strCalcIDSQL As String              'Wenn intCalcIDType = 3 dann wird hier der SQL Befehl benötigt. Das Ergebnis des SQL Staements muss im Feld strdbFieldKey stehen

Dim WithEvents objForm As Form
Dim WithEvents objBtnCancle As CommandButton
Dim WithEvents objBtnSelect As CommandButton
Dim WithEvents objTreeView As TreeView
Dim WithEvents objBtnSaveSelected As CommandButton
Dim WithEvents objBtnDeleteSelected As CommandButton
Dim WithEvents objBtnAdd As CommandButton

Private Const strKeyPre As String = "MASTER"

Property Get CalcIDSQL() As String
    CalcIDSQL = strCalcIDSQL
End Property

Property Let CalcIDSQL(Value As String)
    strCalcIDSQL = Value
End Property

Property Get CalcIDType() As CalcIDTypes
    CalcIDType = intCalcIDType
End Property

Property Let CalcIDType(Value As CalcIDTypes)
    intCalcIDType = Value
End Property

Property Get Selected() As Long
    Selected = lngSelectedValue
End Property

Property Let FormType(Value As FormTypeValues)
    intFormType = Value
End Property

Property Get FormType() As FormTypeValues
    FormType = intFormType
End Property

Property Let TreeName(Value As String)
    strTreeName = Value
End Property

Property Get TreeName() As String
    TreeName = strTreeName
End Property

Property Let Formname(Value As String)
    strFormname = Value
End Property

Property Get Formname() As String
    Formname = strFormname
End Property

' Tabellenfunktionen
Property Let dbTable(Value As String)
    strdbTable = Value
End Property

Property Get dbTable() As String
    dbTable = strdbTable
End Property

Property Let dbFieldKey(Value As String)
    strdbFieldKey = Value
End Property

Property Get dbFieldKey() As String
    dbFieldKey = strdbFieldKey
End Property

Property Let dbFieldViewName(Value As String)
    strdbFieldViewName = Value
End Property

Property Get dbFieldViewName() As String
    dbFieldViewName = strdbFieldViewName
End Property

Property Let dbParentKey(Value As String)
    strdbParentKey = Value
End Property

Property Get dbParentKey() As String
    dbParentKey = strdbParentKey
End Property

Property Let dbKZ(Value As String)
    strdbKZ = Value
End Property

Property Get dbKZ() As String
    dbKZ = strdbKZ
End Property

Public Sub OpenTreeView()
    readData
End Sub

Public Sub AddWhere(Fieldname As String, Value As String, FieldType As FieldTypeValues)
    intWhere = intWhere + 1
    ReDim Preserve datWhere(intWhere)
    datWhere(intWhere).Fieldname = Fieldname
    datWhere(intWhere).FieldValue = Value
    datWhere(intWhere).FieldValueType = FieldType
    
End Sub

Public Function GetWhere() As String
    Dim intCount As Integer
    Dim strWhere As String
    If intWhere > 0 Then
        For intCount = LBound(datWhere) To UBound(datWhere)
            If Len(strWhere) > 0 Then strWhere = strhwere & " AND "
            Select Case datWhere(intCount).FieldValueType
                Case FieldTypeValues.DateTime
                    strWhere = strWhere & datWhere(intCount).Fieldname & "=" & SQLDateTime(datWhere(intCount).FieldValue)
                Case FieldTypeValues.Number
                    strWhere = strWhere & datWhere(intCount).Fieldname & "=" & datWhere(intCount).FieldValue
                Case FieldTypeValues.Text
                    strWhere = strWhere & datWhere(intCount).Fieldname & "='" & datWhere(intCount).FieldValue & "'"
            End Select
        Next
    End If
    GetWhere = strWhere
End Function

Public Function SQLDateTime(varDate As Variant) As String
    If IsDate(varDate) = True Then
        If varDate >= 1 Then
            If CLng(varDate) <> CDbl(varDate) Then
                SQLDateTime = Format(CDate(varDate), "#mm/dd/yyyy hh:nn:ss#")
            Else
                SQLDateTime = Format(CDate(varDate), "#mm/dd/yyyy#")
            End If
        Else
            SQLDateTime = Format(CDate(varDate), "#hh:nn:ss#")
        End If
    Else
        SQLDateTime = ""
    End If
End Function

Public Sub readData()
    If CheckData = True Then
        With objForm
            Select Case intFormType
                Case 1 'Edit
                    objBtnCancle.Visible = False
                    objBtnSelect.Visible = True
                    objBtnSelect.Caption = strCaptionButtonClose
                    objBtnSaveSelected.Visible = True
                    objBtnDeleteSelected.Visible = True
                    objBtnAdd.Visible = True
                    objForm.fldSelected.Visible = True
                    objForm.BezeichnungfldSelected.Visible = True
                    objForm.fldAdd.Visible = True
                    objForm.BezeichnungfldAdd.Visible = True
                Case 2 'Select
                    objBtnCancle.Visible = True
                    objBtnSelect.Visible = True
                    objBtnSelect.Caption = strCaptionButtonSelect
                    objBtnSaveSelected.Visible = False
                    objBtnDeleteSelected.Visible = False
                    objBtnAdd.Visible = False
                    objForm.fldSelected.Visible = False
                    objForm.BezeichnungfldSelected.Visible = False
                    objForm.fldAdd.Visible = False
                    objForm.BezeichnungfldAdd.Visible = False
            End Select
            .Caption = strFormname
            .ViewsAllowed = 1
            .Visible = True
            bitActive = True
        End With
        LoadTreeViewData
    End If
End Sub

Private Function CheckData() As Boolean
    On Error GoTo CheckData_Error
   
    If Len(strdbTable) = 0 Or IsNull(strdbtabel) = True Then
        Err.Raise 1000 + vbObjectError, "dbTable", "TREEEDIT:Es wurde keine Tabelle angegeben!"
    End If
    If Len(strdbFieldKey) = 0 Or IsNull(strdbFieldKey) = True Then
        Err.Raise 1001 + vbObjectError, "dbTable", "TREEEDIT:Es wurde keine KEY Feld angegeben!"
    End If
    If Len(strdbFieldViewName) = 0 Or IsNull(strdbFieldViewName) = True Then
        Err.Raise 1002 + vbObjectError, "dbFieldViewName", "TREEEDIT:Es wurde keine Anzeigename angegeben!"
    End If
        If Len(strdbParentKey) = 0 Or IsNull(strdbParentKey) = True Then
        Err.Raise 1003 + vbObjectError, "dbParentKey", "TREEEDIT:Es wurde keine Feld ParentKey angegeben!"
    End If
        If Len(strdbKZ) = 0 Or IsNull(strdbKZ) = True Then
        Err.Raise 1004 + vbObjectError, "dbKZ", "TREEEDIT:Es wurde keine Kennzeichen angegeben!"
    End If
CheckData_Exit:
    CheckData = True
    Exit Function
CheckData_Error:
    MsgBox "Fehler-Nummer: " & Err.Number - vbojecterror & vbCrLf & "Fehler-Beschreibung: " & Err.Description, , Err.Source
End Function

Private Sub Class_Initialize()
    Set objForm = New Form_FORM_TREEEDIT
    Set objBtnCancle = objForm.btnCancel
    Set objBtnSelect = objForm.btnSelect
    Set objTreeView = objForm.TreeView.Object
    Set objBtnSaveSelected = objForm.btnSaveSelected
    Set objBtnDeleteSelected = objForm.btnDeleteSelected
    Set objBtnAdd = objForm.btnAdd
    intFormType = 1
    intWhere = 0
    strCaptionButtonSelect = "&Auswählen"
    strCaptionButtonClose = "&Schließen"
End Sub

Public Function IsActive() As Boolean
    If bitActive = True Then
        If Not objForm Is Nothing Then
            IsActive = objForm.Visible
            bitActive = objForm.Visible
        Else
            IsActive = False
            bitActive = False
        End If
    Else
        IsActive = False
    End If
End Function

Private Sub objBtnAdd_Click()
    Dim strSQL As String
    Dim lngNewID As Long
    Dim strKey As String
    Dim objNode As Node
    Dim strFields As String
    Dim strValues As String
    Dim intField As Integer
    If Len(objTreeView.SelectedItem.Key) > 0 Then
        If intWhere > 0 Then
            For intField = 1 To intWhere
            
                strFields = strFields & "," & datWhere(intField).Fieldname
                Select Case datWhere(intField).FieldValueType
                    Case FieldTypeValues.DateTime
                        strValues = strValues & "," & SQLDateTime(datWhere(intField).FieldValue)
                    Case FieldTypeValues.Number
                        strValues = strValues & "," & datWhere(intField).FieldValue
                    Case FieldTypeValues.Text
                        strValues = strValues & ",'" & datWhere(intField).FieldValue & "'"
                End Select
            Next
        End If
        If GetTreeID(objTreeView.SelectedItem.Key) > 0 Then
            Select Case intCalcIDType
                Case CalcIDTypes.MaxPlus1, CalcIDTypes.SQLString
                    lngNewID = GetNewID
                    strSQL = "INSERT INTO " & strdbTable & " (" & dbFieldKey & "," & strdbFieldViewName & "," & strdbParentKey & strFields & ") VALUES (" & lngNewID & ",'" & objForm.fldAdd & "'," & GetTreeID(objTreeView.SelectedItem.Key) & strValues & ");"
                    RunSQL strSQL
                    strKey = "KEY" & lngNewID
                Case Else
                    strSQL = "INSERT INTO " & strdbTable & " (" & strdbFieldViewName & "," & strdbParentKey & strFields & ") VALUES ('" & objForm.fldAdd & "'," & GetTreeID(objTreeView.SelectedItem.Key) & strValues & ");"
                    RunSQL strSQL
                    lngNewID = CurrentDb().OpenRecordset("SELECT @@IDENTITY From " & strdbTable & ";")(0)
                    strKey = "KEY" & lngNewID
            End Select
            Set objNode = objTreeView.Nodes.Add(objTreeView.SelectedItem.Key, tvwChild, strKey, objForm.fldAdd)
            objNode.Expanded = True
        Else
            Select Case intCalcIDType
                Case CalcIDTypes.MaxPlus1, CalcIDTypes.SQLString
                    lngNewID = GetNewID
                    strSQL = "INSERT INTO " & strdbTable & " (" & dbFieldKey & "," & strdbFieldViewName & strFields & ") VALUES (" & lngNewID & ",'" & objForm.fldAdd & "'" & strValues & ");"
                    strKey = "KEY" & lngNewID
                    RunSQL strSQL
                Case Else
                    strSQL = "INSERT INTO " & strdbTable & " (" & strdbFieldViewName & strFields & ") VALUES ('" & objForm.fldAdd & "'" & strValues & ");"
                    RunSQL strSQL
                    lngNewID = CurrentDb().OpenRecordset("SELECT @@IDENTITY From " & strdbTable & ";")(0)
                    strKey = "KEY" & lngNewID
            End Select
            Set objNode = objTreeView.Nodes.Add(strKeyPre, tvwChild, strKey, objForm.fldAdd)
            objNode.Expanded = True
        End If
        objForm.fldAdd = ""
    Else
        MsgBox "Bitte erst ein Wert auswählen unter dem der neue Wert angelegt wird!", vbOKOnly, "Achtung!"
    End If
End Sub

Private Function GetNewID()
    Dim strSQL As String
    Dim intField As Integer
    Dim rs As DAO.Recordset
    Dim varValue As Variant
    Select Case intCalcIDType
        Case CalcIDTypes.MaxPlus1
            strSQL = "SELECT MAX(" & dbFieldKey & ")+1 AS NewID FROM " & dbTable
            If intWhere > 0 Then
                strSQL = strSQL & " WHERE "
                For intField = 1 To intWhere
                    If intField > 1 Then strSQL = strSQL & " AND "
                    Select Case datWhere(intField).FieldValueType
                        Case FieldTypeValues.DateTime
                            strSQL = strSQL & datWhere(intField).Fieldname & "=" & SQLDateTime(datWhere(intField).FieldValue)
                        Case FieldTypeValues.Number
                            strSQL = strSQL & datWhere(intField).Fieldname & "=" & datWhere(intField).FieldValue
                        Case FieldTypeValues.Text
                            strSQL = strSQL & datWhere(intField).Fieldname & "='" & datWhere(intField).FieldValue & "'"
                    End Select
                Next
            End If
            varValue = CurrentDb().OpenRecordset(strSQL)(0)
        Case CalcIDTypes.SQLString
            varValue = CurrentDb().OpenRecordset(strCalcIDSQL)(0)
        Case Else
            varValue = 0
    End Select
    If IsNull(varValue) = True Then
        GetNewID = 1
    Else
        GetNewID = CLng(varValue)
    End If
End Function

Private Sub RunSQL(strSQL As String)
    'Debug.Print strSQL
    CurrentDb.Execute strSQL
End Sub
' Events aus dem Formular

Private Sub objBtnCancle_Click()
    objForm.Visible = False
    lngSelectedValue = 0
End Sub


Private Sub objBtnDeleteSelected_Click()
    Dim strSQL As String
    If objTreeView.SelectedItem.Key = strKeyPre Then
        MsgBox "Der Master Eintrag kann nicht gelöscht werden!", vbInformation, "Info!"
        Exit Sub
    End If
    If objTreeView.SelectedItem.Children > 0 Then
        MsgBox "Es sind dem Eintrag andere Einträge zugeordnet. Bitte diese zuerst löschen!", vbInformation, "Info!"
    Else
        If MsgBox("Den Eintrag: " & objTreeView.SelectedItem.Text & " wirklich löschen?", vbYesNo, "Löschen?") = vbYes Then
            strSQL = "DELETE FROM " & strdbTable & " WHERE " & dbFieldKey & "=" & GetTreeID(objTreeView.SelectedItem.Key)
            If Len(GetWhere) > 0 Then
                strSQL = strSQL & " AND " & GetWhere
            End If
            RunSQL strSQL
            objTreeView.Nodes.Remove (objTreeView.SelectedItem.Key)
        End If
    End If
End Sub

Private Sub objBtnSaveSelected_Click()
    Dim strSQL As String
    If Len(objForm.fldSelected) > 0 And Len(objTreeView.SelectedItem.Key) > 0 Then
        If Not objTreeView.SelectedItem.Key = strKeyPre Then
            objTreeView.SelectedItem.Text = objForm.fldSelected
            strSQL = "UPDATE " & strdbTable & " SET " & dbFieldViewName & "='" & objForm.fldSelected & "' WHERE " & dbFieldKey & "= " & GetTreeID(objTreeView.SelectedItem.Key)
            If Len(GetWhere) > 0 Then
                strSQL = strSQL & " AND " & GetWhere
            End If
            RunSQL strSQL
        End If
    End If
End Sub


' Laden der TreeviewDaten
Private Sub LoadTreeViewData()
    Dim rs As DAO.Recordset
    Dim strSQL As String
    Dim strKey As String
    Dim objNode As Node
    If Not Len(strTreeName) > 0 Then
        Set objNode = objTreeView.Nodes.Add(, , strKeyPre, strdbTable)
    Else
        Set objNode = objTreeView.Nodes.Add(, , strKeyPre, strTreeName)
    End If
    objNode.Expanded = True
    strSQL = "SELECT * FROM " & strdbTable & " WHERE (ISNULL(" & strdbParentKey & ")=TRUE OR " & strdbParentKey & "=0)"
    If Len(GetWhere) > 0 Then
        strSQL = strSQL & " AND " & GetWhere
    End If
    Debug.Print strSQL
    'strSQL = "SELECT * FROM ABTEILUNGEN WHERE ISNULL(ABTEILUNG_KEY_PARENT)=TRUE"
    Set rs = CurrentDb.OpenRecordset(strSQL)
    While Not rs.EOF
        strKey = "KEY" & rs.Fields(dbFieldKey)
        Set objNode = objTreeView.Nodes.Add(strKeyPre, tvwChild, strKey, rs.Fields(dbFieldViewName))
        objNode.Expanded = True
        LoadTreeVuewSubData rs.Fields(dbFieldKey)
        
        rs.MoveNext
    Wend
    rs.Close
End Sub

Private Sub LoadTreeVuewSubData(lngParentID As Long)
    Dim rs As DAO.Recordset
    Dim strSQL As String
    Dim strKey As String
    Dim strParentKey As String
    strParentKey = "KEY" & lngParentID
    strSQL = "SELECT * FROM " & strdbTable & " WHERE " & strdbParentKey & "=" & lngParentID
    If Len(GetWhere) > 0 Then
        strSQL = strSQL & " AND " & GetWhere
    End If
    Debug.Print strSQL
    Set rs = CurrentDb.OpenRecordset(strSQL)
    While Not rs.EOF
        strKey = "KEY" & rs.Fields(dbFieldKey)
        Set objNode = objTreeView.Nodes.Add(strParentKey, tvwChild, strKey, rs.Fields(dbFieldViewName))
        LoadTreeVuewSubData rs.Fields(dbFieldKey)
        rs.MoveNext
    Wend
    rs.Close
End Sub



Private Sub objBtnSelect_Click()
    SelectOrExit
End Sub


Private Sub objForm_Close()
    bitActive = False
End Sub



Private Sub objTreeView_DblClick()
    Select Case intFormType
        Case FormTypeValues.SelectValue
            SelectOrExit
        Case FormTypeValues.EditValues
    End Select
End Sub

Private Sub SelectOrExit()
    Select Case intFormType
        Case FormTypeValues.SelectValue
            lngSelectedValue = GetTreeID(objTreeView.SelectedItem.Key)
            objForm.Visible = False
        Case FormTypeValues.EditValues
            lngSelectedValue = 0
            objForm.Visible = False
    End Select
End Sub

Private Sub objTreeView_Click()
    Select Case intFormType
        Case FormTypeValues.SelectValue
            'Nichts passiert!
        Case FormTypeValues.EditValues
            If Not objTreeView.SelectedItem Is Nothing Then
                objForm.fldSelected = objTreeView.SelectedItem.Text
            End If
    End Select
End Sub

Private Function GetTreeID(strKey As String) As Long
    If strKey = strKeyPre Then
        GetTreeID = 0
    Else
        GetTreeID = CLng(Right(strKey, Len(strKey) - 3))
    End If
End Function

Private Sub objTreeView_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
    If intFormType = FormTypeValues.EditValues Then
        Dim objSelectedNode As Node
        If Not objTreeView.SelectedItem Is Nothing Then
            Set objSelectedNode = objTreeView.SelectedItem
            If Not objSelectedNode.Key = strKeyPre Then
                If Not objTreeView.DropHighlight Is Nothing And objSelectedNode.Index <> objTreeView.DropHighlight.Index Then
                    Set objSelectedNode.Parent = objTreeView.DropHighlight
                    Dim strSQL As String
                    strSQL = "UPDATE " & strdbTable & " SET " & strdbParentKey & "=" & GetTreeID(objTreeView.DropHighlight.Key) & " WHERE " & strdbFieldKey & "=" & GetTreeID(objSelectedNode.Key)
                    If Len(GetWhere) > 0 Then
                        strSQL = strSQL & " AND " & GetWhere
                    End If
                    RunSQL strSQL
                    'Debug.Print strSQL
                End If
            End If
            Set objSelectedNode = Nothing
        End If
        Set objTreeView.DropHighlight = Nothing
    End If
End Sub

Private Sub objTreeView_OLEDragOver(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
    If intFormType = FormTypeValues.EditValues Then
        If objTreeView.SelectedItem Is Nothing Then
            Set objTreeView.SelectedItem = objTreeView.HitTest(x, y)
        End If
        Set objTreeView.DropHighlight = objTreeView.HitTest(x, y)
    End If
End Sub

Private Sub objTreeView_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
    If intFormType = FormTypeValues.EditValues Then
        objTreeView.SelectedItem = Nothing
    End If
End Sub

__________________

"Programmers never die, they just GOSUB without RETURN"

Geändert von chbahn (08.11.2017 um 13:31 Uhr).
chbahn ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 13:59 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.

Copyright ©2000-2010 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günther Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.
Beachten Sie bitte auch unsere Nutzungsbedingungen.