Stefanie braucht Hilfe

  • VB6

Es gibt 3 Antworten in diesem Thema. Der letzte Beitrag () ist von Gast.


    Modul:
    Public MDB_Pfad As String
    Public MDB As New ADODB.Connection
    Private Type xRs
    Werk As ADODB.Recordset
    Material As ADODB.Recordset
    Kunden As ADODB.Recordset
    Mitarbeiter As ADODB.Recordset
    Tmp As ADODB.Recordset
    End Type
    Public Rs As xRs
    Public Laden As Boolean

    Public Sub OpenMDB()
    On Error Resume Next
    MDB_Pfad = App.Path & "\AuftragsDB.mdb"

    PW = ""
    Cs = "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=" & PW & ";Persist Security Info=False;Data Source=" & MDB_Pfad & ";Mode=Read|Write" ' |Share Deny None"
    MDB.CursorLocation = adUseClient
    Do While MDB.State = 0 And z < 101
    z = z + 1
    MDB.Open Cs
    Loop
    If MDB.State = 0 Then
    MsgBox "Die Datenbank" & vbCr & "konnte nicht gefunden oder geöffnet werden !"
    End If
    On Error GoTo 0
    End Sub


    Public Sub OpenTabellen(Optional xTabelle, Optional mRead)
    On Error Resume Next
    Dim aRS As New ADODB.Recordset
    If xTabelle = "" Then
    For i = 0 To 3
    Select Case i
    Case 0: xTabelle = "SELECT * FROM Kunden ": GoSub RecordÖffnen: Set Rs.Kunden = aRS: Set aRS = Nothing
    Case 1: xTabelle = "SELECT * FROM Material": GoSub RecordÖffnen: Set Rs.Material = aRS: Set aRS = Nothing
    Case 2: xTabelle = "SELECT * FROM Mitarbeiter": GoSub RecordÖffnen: Set Rs.Mitarbeiter = aRS: Set aRS = Nothing
    Case 3: xTabelle = "SELECT * FROM Auftrag": GoSub RecordÖffnen: Set Rs.Werk = aRS: Set aRS = Nothing

    End Select
    Next i
    Else
    GoSub RecordÖffnen: Set Rs.Tmp = aRS: Set aRS = Nothing
    End If
    Exit Sub

    RecordÖffnen:
    aRS.CursorLocation = adUseClient
    Do While aRS.State <> 1 And z < 11
    z = z + 1
    If mRead = "" Then
    aRS.Open xTabelle, MDB, adOpenKeyset, adLockOptimistic
    Else
    aRS.Open xTabelle, MDB, adOpenKeyset, adLockReadOnly
    End If
    Loop
    If aRS.State <> 1 Then
    MsgBox "Die Tabelle " & xTabelle & vbCr & "konnte nicht gefunden oder geöffnet werden.!"
    End If
    aRS.MarshalOptions = adMarshalModifiedOnly
    Return
    End Sub


    Public Sub Füll_Combo(mRS As ADODB.Recordset, mFeld As ADODB.Field, mCmb As ComboBox)
    On Error Resume Next
    mRS.MoveFirst
    Do While mRS.EOF = False
    mCmb.AddItem mFeld
    mCmb.ItemData(mCmb.NewIndex) = mRS!ID
    mRS.MoveNext
    Loop
    mRS.MoveFirst
    On Error GoTo 0
    End Sub
    Public Sub Füll_Combo2(mRS As ADODB.Recordset, mFeld As ADODB.Field, mCmb As ListBox)
    On Error Resume Next
    mRS.MoveFirst
    Do While mRS.EOF = False
    mCmb.AddItem mFeld
    mCmb.ItemData(mCmb.NewIndex) = mRS!ID
    mRS.MoveNext
    Loop
    mRS.MoveFirst
    On Error GoTo 0
    End Sub


    Public Sub Neu()

    On Error Resume Next
    Unload Form_Start
    Unload Form_Wissen
    Unload frm_Bildpfad
    Unload frmThema
    Unload frmSuchen
    Shell App.Path & "\" & "Wissen" & ".exe", vbNormalFocus

    On Error GoTo 0

    End Sub

    'Sub Main()
    'Form_Start.Show
    'End Sub


    Public Sub Entlocken()
    For i = 0 To 3
    Form_Wissen.Text1(i).Locked = False
    Next i
    Form_Wissen.cmbArt.Locked = False
    End Sub

    Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Const CB_SHOWDROPDOWN = &H14F
    Private Bookwerk



    Private Sub Command1_Click()
    dg_Book.HoldFields
    Rs.Werk.Filter = adFilterNone

    With Rs.Werk
    Rs.Werk.Close
    Rs.Werk.Source = ("SELECT [Auftrag].[ID_Auftrag], [Auftrag].[AuftragsNR], [Auftrag].[ID_Kunde], [Auftrag].[ID_Material], [Auftrag].[ID_Mitarbeiter], [Auftrag].[Datum], [Auftrag].[Preis], [Kunden].[Firmenname], [Kunden].[Ort], [Kunden].[Strasse], [Kunden].[PLZ], [Kunden].[Telefon], [Kunden].[ID] AS Kunden_ID, [Material].[Material], [Material].[ID] AS Material_ID, [Material].[MaterialGruppe], [Mitarbeiter].[ID] AS Mitarbeiter_ID, [Mitarbeiter].[Mitarbeiter], [Mitarbeiter].[Vorname], [Mitarbeiter].[Tel], [Mitarbeiter].[Kennung]" _
    & " FROM Mitarbeiter INNER JOIN (Material INNER JOIN (Kunden INNER JOIN Auftrag ON [Kunden].[ID] =[Auftrag].[ID_Kunde]) ON [Material].[ID] =[Auftrag].[ID_Material]) ON [Mitarbeiter].[ID] =[Auftrag].[ID_Mitarbeiter]")

    .CursorType = adOpenStatic
    Rs.Werk.Open , , , , adCmdText
    Rs.Werk.Requery
    End With

    End Sub



    Private Sub bn_Button_Click(Index As Integer)
    On Error Resume Next
    If Rs.Werk.EditMode = adEditAdd Then
    Rs.Werk.Update
    If Err.Number <> 0 Then
    Rs.Werk.CancelBatch
    dg_Book.HoldFields: Rs.Werk.Requery: dg_Book.Refresh: Rs.Werk.Bookmark = Bookwerk: Exit Sub
    Else
    dg_Book.HoldFields: Rs.Werk.Requery: Rs.Werk.MoveLast: dg_Book.Refresh
    End If
    End If


    On Error GoTo 0


    End Sub



    Private Sub cmb_Tabellen_Click(Index As Integer)
    On Error Resume Next
    If Laden = True Then Exit Sub
    Dusty = Trim(cmb_Tabellen(4).Text)
    Leo = Trim(cmb_Tabellen(5).Text)

    Select Case Index
    k.Refresh:
    Case 4
    Rs.Werk.Filter = "Firmenname = '" & Dusty & "'"
    Case 5
    Rs.Werk.Filter = "Material = '" & Leo & "'"

    End Select

    On Error GoTo 0
    End Sub

    Private Sub cmb_Tabellen_GotFocus(Index As Integer)
    Select Case Index
    Case 1
    SendMessage cmb_Tabellen(1).hWnd, CB_SHOWDROPDOWN, True, 0
    Case 2
    SendMessage cmb_Tabellen(2).hWnd, CB_SHOWDROPDOWN, True, 0
    Case 3
    SendMessage cmb_Tabellen(3).hWnd, CB_SHOWDROPDOWN, True, 0
    End Select
    End Sub

    Private Sub dg_Book_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
    On Error Resume Next
    Laden = True
    If Rs.Werk.EditMode = adEditAdd Then Laden = False: Exit Sub
    If Rs.Werk.EOF Then Exit Sub
    For i = 0 To cmb_Tabellen(1).ListCount
    If cmb_Tabellen(Index).ItemData(cmb_Tabellen(Index).ListIndex) = Rs.Werk!ID_Kunde Then
    cmb_Tabellen(1).ListIndex = i
    End If
    Next i
    Rs.Kunden.MoveFirst
    Rs.Kunden.Find "FirmenID = " & Rs.Werk!ID_Kunde
    cmb_Tabellen(1).ListIndex = Rs.Kunden.AbsolutePosition - 1

    Rs.Material.MoveFirst
    Rs.Material.Find "MaterialID = " & Rs.Werk!ID_Material
    cmb_Tabellen(2).ListIndex = Rs.Material.AbsolutePosition - 1


    Laden = False
    End Sub

    Private Sub Form_Load()

    Laden = True
    Call OpenMDB
    Call OpenTabellen
    Call OpenTabellen("SELECT [Auftrag].[ID_Auftrag], [Auftrag].[AuftragsNR], [Auftrag].[ID_Kunde], [Auftrag].[ID_Material], [Auftrag].[ID_Mitarbeiter], [Auftrag].[Datum], [Auftrag].[Preis], [Kunden].[Firmenname], [Kunden].[Ort], [Kunden].[Strasse], [Kunden].[PLZ], [Kunden].[Telefon], [Kunden].[ID] AS Kunden_ID, [Material].[Material], [Material].[ID] AS Material_ID, [Material].[MaterialGruppe], [Mitarbeiter].[ID] AS Mitarbeiter_ID, [Mitarbeiter].[Mitarbeiter], [Mitarbeiter].[Vorname], [Mitarbeiter].[Tel], [Mitarbeiter].[Kennung]" _
    & " FROM Mitarbeiter INNER JOIN (Material INNER JOIN (Kunden INNER JOIN Auftrag ON [Kunden].[ID] =[Auftrag].[ID_Kunde]) ON [Material].[ID] =[Auftrag].[ID_Material]) ON [Mitarbeiter].[ID] =[Auftrag].[ID_Mitarbeiter]")


    Set Rs.Werk = Rs.Tmp: Set Rs.Tmp = Nothing
    Call Füll_Combo2(Rs.Mitarbeiter, Rs.Mitarbeiter!Mitarbeiter, List2)
    Call Füll_Combo2(Rs.Mitarbeiter, Rs.Mitarbeiter!Vorname, List1)

    For i = 1 To 7
    Select Case i
    Case 1: Call Füll_Combo(Rs.Kunden, Rs.Kunden!Firmenname, cmb_Tabellen(i))
    Case 2: Call Füll_Combo(Rs.Material, Rs.Material!Material, cmb_Tabellen(i))
    Case 3: Call Füll_Combo(Rs.Mitarbeiter, Rs.Mitarbeiter!Mitarbeiter, cmb_Tabellen(i))
    Case 4: Call Füll_Combo(Rs.Kunden, Rs.Kunden!Firmenname, cmb_Tabellen(i))
    Case 5: Call Füll_Combo(Rs.Material, Rs.Material!Material, cmb_Tabellen(i))

    End Select

    Next i
    For i = 0 To 12
    Set Text1(i).DataSource = Rs.Werk
    Next i
    Set dg_Book.DataSource = Rs.Werk

    dg_Book.Columns("ID_Auftrag").Width = 0
    1000
    Laden = False
    Call dg_Book_RowColChange(1, 1)
    End Sub