Thema Datum  Von Nutzer Rating
Antwort
Rot Multiple-Choice-Quiz bei Excel VBA
20.05.2023 12:10:54 ivano
NotSolved
20.05.2023 14:13:24 Gast2234
NotSolved

Ansicht des Beitrags:
Von:
ivano
Datum:
20.05.2023 12:10:54
Views:
310
Rating: Antwort:
  Ja
Thema:
Multiple-Choice-Quiz bei Excel VBA

Hallo liebes Forum :-)

ich bin absoluter Beginner in VBA und würde mich sehr über eure Hilfe in meinem Anliegen freuen.

Meine Idee war es, mehrere Multiple-Choice-Quiz (mit verschiedenen Fragen/Themen) auf verschiedenen Datenblättern zu kreieren. Über ein Youtubevideo bin ich auf folgenden Code gestoßen der es mir ermöglicht ein Quiz anhand von vorgefertigten Fragen mit Antworten zu starten.

Private Sub CommandButton1_Click()
     If OptionButton1 = True And Sheets(2).Cells(a, 5) = 1 Or OptionButton2 = True And Sheets(2).Cells(a, 5) = 2 Or OptionButton3 = True And Sheets(2).Cells(a, 5) = 3 Then
        Unload Me
    Else
        If OptionButton1 = True Then
             OptionButton1.ForeColor = vbRed
        End If
         If OptionButton2 = True Then
             OptionButton2.ForeColor = vbRed
        End If
         If OptionButton3 = True Then
             OptionButton3.ForeColor = vbRed
        End If
        fehler = fehler + 1
    End If
End Sub

Private Sub CommandButton2_Click()
    quit = 1
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    UserForm1.Caption = "Frage " & i & " von 10"
    Label1 = Sheets(2).Cells(a, 1)
    OptionButton1.Caption = Sheets(2).Cells(a, 2)
    OptionButton2.Caption = Sheets(2).Cells(a, 3)
    OptionButton3.Caption = Sheets(2).Cells(a, 4)
End Sub
 

und das Modul dazu sieht wie folgt aus:

Global a, i, fehler, quit As Integer

Sub test()

    Dim y(1 To 10), mini, temp As Integer
    fehler = 0
    quit = 0
    For i = 1 To 10
        mini = WorksheetFunction.Min(Sheets(2).Columns(6))
        Do
            temp = 0
            a = Int(Rnd * 70) + 1
            For j = 1 To 10
                If a = y(j) Then
                    temp = 1
                End If
            Next
            If Sheets(2).Cells(a, 6) - mini >= 2 Then
                temp = 1
            End If
        Loop Until temp = 0
        Sheets(2).Cells(a, 6) = Sheets(2).Cells(a, 6) + 1
        y(i) = a
        UserForm1.Show
        If quit = 1 Then
            Exit For
        End If
    Next
    MsgBox "Du hast " & fehler & " Fehler!", vbOKOnly
        
End Sub
 

Jetzt kommt mein Anliegen. Ich würde gerne weitere solcher Quizfunktionen auf den anderen Blättern einfügen. Wenn ich dies durch plumpes copy-paste (ja ich weiß das es dumm ist aber wie gesagt ich hab garkeine ahnung :P) einfüge, spuckt mir das Programm Fehlermeldungen aus mit denen ich leider nicht umgehen kann.

Falls ihr mein Anliegen versteht und mir helfen könntet wäre ich euch wirklich sehr dankbar.

Lieben Gruß

Ivano

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Multiple-Choice-Quiz bei Excel VBA
20.05.2023 12:10:54 ivano
NotSolved
20.05.2023 14:13:24 Gast2234
NotSolved