Kontrollkästchen - Werte übertragen

[larryfilou]

Folgendes Problem in VBA für ACCESS

User soll vier Fragen durch klicken auf Kontrollkästchen beantworten.

Aus den Antworten wird eine Summe gebildet (Jede Antwort gibt bei Nein den Wert 0 und bei Ja "2 hoch seine Ordnungsnummer" aus = Also 1, 2, 4, 8)

Die Summe der Werte ergibt die korrekte Antwort, für die ein entsprechendes Formular mit Bild der Antwort ausgegeben wird.

Das Ganze kann beliebig oft wiederholt werden (in den Antwortformularen sind Buttons die entweder das Programm beenden oder wieder von vorne starten).

Problem: Sobald ich das Programm ein zweites Mal laufen lasse, wird der LETZT gesetze Wert des Formulares NICHT gesetzt:

Statt das also zB das gewählte Ja, Ja, Nein, Ja auftaucht, bleiben zB alle auf Ja, wie im Durchlauf zuvor. TROTZDEM ich alles zurücksetze nach jedem Durchlauf!!! Hier ist der Quellcode, vielleicht findet jemand einen Denkfehler?

Private Sub Befehl8_Click()


DoCmd.Save acForm, "Abfrage"

DoCmd.Save


'Variablen initiieren

Dim db As DAO.Database

Dim rs As Recordset

Dim aw As Recordset

Dim Summe As Double

Dim Wert As Boolean

Dim i As Integer


'Tabellen aktivieren

Set db = CurrentDb

Set rs = db.OpenRecordset("Fragen")

Set aw = db.OpenRecordset("Antworten")

Summe = 0


'Setzt Tabellenwerte = Formularwerte => evtl doppelt wg Speichern später?

rs.MoveFirst

Do Until rs.EOF = True

    If [Sinnvoll?] <> rs![Sinnvoll?] Then

            rs.Edit

            rs![Sinnvoll?] = [Sinnvoll?]

            rs.MoveNext

        Else

            rs.MoveNext

        End If

Loop


'Schliessen Formular, um Werte in Tabelle zu übertragen und zu sichern

DoCmd.Close acForm, "Abfrage", acSaveYes


rs.MoveFirst

Do Until rs.EOF = True

    If rs![Sinnvoll?] = True Then

        Summe = Summe + rs!Ordnungszahl

        rs.MoveNext

    Else

        Summe = Summe + 0

        rs.MoveNext

    End If

Loop


'Sucht korrekte Antwort raus

aw.MoveFirst


Do

    If aw!Wert < Summe Then

        aw.MoveNext

    Else

        Select Case Summe

            Case 0 To 3, 6, 7

                DoCmd.OpenForm ("Fachboden")

            Case 4, 5

                DoCmd.OpenForm ("BlocklagerKLT")

            Case 8 To 11, 14, 15

                DoCmd.OpenForm ("Stapler")

            Case Else

                DoCmd.OpenForm ("BlocklagerGLT")

        End Select

    aw.MoveLast

    aw.MoveNext

    End If

Loop Until aw.EOF = True


rs.MoveFirst


Do

    rs.Edit

    rs![Sinnvoll?] = -1

    rs.Update

    rs.MoveNext

Loop Until rs.EOF = True


End Sub