Spielerwechsel mit Case Bezug auf Zelle

Question

Ein nettes Hallo an die Experten.

Habe für mich ein großes Problem da ich nicht weiter komme, vielleicht kann mir jemand helfen. Vorab ich habe mein Dartspiel total verändert, nicht mehr mit Doppelklick sondern mit einem Klick. Nun versuche ich das Spiel mit maximal 6 Spieler zu gestalten. Mit 6 Spieler klappt es, aber ich möchte es mit 2, 3, 4 oder 5 gestalten und da weiß ich nicht wie ich das anstellen soll habe in  Netz gestöbert aber ich finde nichts was mir wirklich hilft, daher wende ich mich an euch in der Hoffnung ihr könnt mir helfen. Ich brauche ein Bezug auf die Zelle M22 die angibt wieviel Spieler es Sind. Es geht um Wechsel der Spieler nach 3 Würfe. Das ist mein VBA für 6 Spieler:

Sub Spieler_wechseln()

Dim AufnahmeErgebnis As Long

AufnahmeErgebnis = Range("F3").Value + Range("G3").Value + Range("H3").Value

' Setze die Farbe aller Spieler zurück

Cells(6, 13).Interior.Color = 15921906 ' Spieler 1

Cells(7, 13).Interior.Color = 15921906 ' Spieler 2

Cells(8, 13).Interior.Color = 15921906 ' Spieler 3

Cells(9, 13).Interior.Color = 15921906 ' Spieler 4

Cells(10, 13).Interior.Color = 15921906 ' Spieler 5

Cells(11, 13).Interior.Color = 15921906 ' Spieler 6

' Aktualisiere die Punkte und wechsle den aktiven Spieler

Select Case aktiver_Spieler

Case 1

Range("P6").Value = Range("P6").Value - AufnahmeErgebnis

aktiver_Spieler = 2

Case 2

Range("P7").Value = Range("P7").Value - AufnahmeErgebnis

aktiver_Spieler = 3

Case 3

Range("P8").Value = Range("P8").Value - AufnahmeErgebnis

aktiver_Spieler = 4

Case 4

Range("P9").Value = Range("P9").Value - AufnahmeErgebnis

aktiver_Spieler = 5

Case 5

Range("P10").Value = Range("P10").Value - AufnahmeErgebnis

aktiver_Spieler = 6

Case 6

Range("P11").Value = Range("P11").Value - AufnahmeErgebnis

aktiver_Spieler = 1

End Select

' Setze die Farbe des aktiven Spielers

Cells(aktiver_Spieler + 1, 6).Interior.Color = 5287936

' Stelle sicher, dass die Zellen für Spieler 3 bis 6 korrekt referenziert werden

If aktiver_Spieler = 1 Then Cells(6, 13).Interior.Color = 5287936

If aktiver_Spieler = 2 Then Cells(7, 13).Interior.Color = 5287936

If aktiver_Spieler = 3 Then Cells(8, 13).Interior.Color = 5287936

If aktiver_Spieler = 4 Then Cells(9, 13).Interior.Color = 5287936

If aktiver_Spieler = 5 Then Cells(10, 13).Interior.Color = 5287936

If aktiver_Spieler = 6 Then Cells(11, 13).Interior.Color = 5287936

' Zeige die Nummer des aktiven Spielers in Zelle T6 an

Range("T6").Value = aktiver_Spieler

End Sub Ich zeig euch noch meine Änderung, wenn Ich Case zwei  von 3 auf 1 ändere macht er den Spielerwechsel von 1 auf 2und umgekehrt. aber wie kriege ich es hin wenn es drei Spieler oder medhr sind?  Ich denke ich brauch ein Bezug auf die Zelle M22. die Aussagt wieviel Spieler es sind. Würde gerne meine Dartliste zur Verfügung stellen wenn benötigt wird. Denn es kommt später noch ein Bitte wegen Ansage der Punktzahl. Gruß Adde

Das ist die Datei

https://supportnet.de/forum/?qa=blob&qa_blobid=5533109443256895351

Das ist die Zuordnung für die Spieler wer dran ist.

 ' Aktualisiere die Punkte und wechsle den aktiven Spieler
    Select Case aktiver_Spieler
        Case 1
            Range("P6").Value = Range("P6").Value - AufnahmeErgebnis
            aktiver_Spieler = 2
        Case 2
            Range("P7").Value = Range("P7").Value - AufnahmeErgebnis
            aktiver_Spieler = 3
        Case 3
            Range("P8").Value = Range("P8").Value - AufnahmeErgebnis
            aktiver_Spieler = 4
        Case 4
            Range("P9").Value = Range("P9").Value - AufnahmeErgebnis
            aktiver_Spieler = 5
        Case 5
            Range("P10").Value = Range("P10").Value - AufnahmeErgebnis
            aktiver_Spieler = 6
        Case 6
            Range("P11").Value = Range("P11").Value - AufnahmeErgebnis
            aktiver_Spieler = 1
    End Select

Wenn Ich Case 2, die 3 auf 1 ändere, wechselt er von 1 auf 2, von 2 auf 1, das ist für 2 Spieler .

Wenn Ich Case 3, die 4 auf 1 ändere, wechselt er von 1 auf 2, von 2 auf 3, von 3 auf 1, das ist für 3 Spieler. 

Wenn Ich Case 4, die 5 auf 1 ändere, wechselt er von 1 auf 2, von 2 auf 3, von 3 auf 4, von 4 auf 1 das ist für 4 Spieler .

Wenn Ich Case 5, die 6 auf 1 ändere, wechselt er von 1 auf 2, von 2 auf 3, von 3 auf 4, von 4 auf 5, von 5, von 5 auf 1 ändere das ist für 5 Spieler .

Nun möchte ich das in einem Einklang bringen, dass das greift müsste er auf die Zelle M22 greifen den diese sagt aus, wieviel Spieler es sind. Hoffe es hilft ein wenig es besser zu verstehen.

Gruß Adde

Answer 1

Hi Adde, da sich hier noch niemand gemeldet hat, hier mal ein kleiner Tipp von mir: Anstelle des Case_Blocks würde ich das (ungetestet!) so aufbauen:

' Aktualisiere die Punkte und wechsle den aktiven Spieler

Range("P6:P11").Cells(aktiver_Spieler).Value = Range("P6:P11").Cells(aktiver_Spieler).Value - AufnahmeErgebnis

aktiver_Spieler = aktiver_Spieler + 1

If aktiver_Spieler > Range("M22").Value then aktiver_Spieler = 1

Gruß Mr. K.

Answer 2

Bezüglich Ansage der Punkte: Welche Office-Version hast du im Einsatz? Und welches Windows? Wenn beides relativ neu ist und du beim Einrichten deines Computers eine Sprachausgabe mit eingerichtet hast, kannst du den Befehl Application.Speech.Speak "mit Text" ausführen.

Ich sehe in deinem Code nicht, dass der Name des aktiven Spielers wechselt. Wenn du den Namen irgendwo per Formel stehen hast (z.B. in Zelle U6) dann könnte der gesamte Code mit Ansage der Punkte (ungetestet) z.B. wie folgt lauten:

Sub Spieler_wechseln()
    Dim AufnahmeErgebnis As Long
    AufnahmeErgebnis = Range("F3").Value + Range("G3").Value + Range("H3").Value
    
    ' Setze die Farbe aller Spieler zurück
    Range("M6:M11").Interior.Color = 15921906
    
    ' Aktualisiere die Punkte und wechsle den aktiven Spieler
    Range("P6:P11").Cells(aktiver_Spieler).Value = Range("P6:P11").Cells(aktiver_Spieler).Value - AufnahmeErgebnis
    
    Application.Speech.Speak Range("U6").Value & " hat " & Range("P6:P11").Cells(aktiver_Spieler).Value & " Punkte."
    
    aktiver_Spieler = aktiver_Spieler + 1
    If aktiver_Spieler > Range("M22").Value Then aktiver_Spieler = 1
    
    ' Setze die Farbe des aktiven Spielers
    Cells(aktiver_Spieler + 1, 6).Interior.Color = 5287936
    
    ' Stelle sicher, dass die Zellen für Spieler 3 bis 6 korrekt referenziert werden
    If aktiver_Spieler = 1 Then Cells(6, 13).Interior.Color = 5287936
    If aktiver_Spieler = 2 Then Cells(7, 13).Interior.Color = 5287936
    If aktiver_Spieler = 3 Then Cells(8, 13).Interior.Color = 5287936
    If aktiver_Spieler = 4 Then Cells(9, 13).Interior.Color = 5287936
    If aktiver_Spieler = 5 Then Cells(10, 13).Interior.Color = 5287936
    If aktiver_Spieler = 6 Then Cells(11, 13).Interior.Color = 5287936
      ' Zeige die Nummer des aktiven Spielers in Zelle T6 an
    Range("T6").Value = aktiver_Spieler
    'An dieser Stelle sollte sich die Formel mit dem Namen des Spielers angepasst haben.
    Application.Speech.Speak Range("U6").Value & " ist an der Reihe."
    
End Sub

Gruß Mr. K.

Answer 3

Hallo und guten Morgen Mr. K.

vielen Dank für deine Antwort.

Habe es umgesetzt und die Zuordnung vom Namen ergänzt. Der Namenswechsel erfolgt in Zelle AB2. Es klappt. Darf ich die eventuell später noch einmal eine Frage stellen. Bezüglich Sunddatei.

Gruß Adde

Answer 4

Hallo Mr. K.

vorab super was du da mir hast zukommen lassen. Teil 1 ist ok

Bei teil 2 Sagt er die Reihenfolge der Spieler an aber leider die Restpunkte anstatt das was er geworfen hat.

Was müsste ich dem Teil des VBA ändern .damit er mir das Wurfergebnis ansagt anstatt die RestpunkteOder soll ich die Datei mal Hochladen?

Gruß Adde

Answer 5

Hi Adde,

Ich gebe zu, ich habe bislang noch keinen Blick in deine Datei geworfen. Ich bin da etwas vorsichtig, da ich mir schon mal bei einer fremden Datei was eingefangen habe. Deshalb antworte ich bevorzugt, lieber auf Basis von Beschreibungen. Du hattest dieses Mal ganz gut beschrieben was Sache ist, daher konnte ich mir ein ungefähres Bild machen.

Die Punktzahl hatten wir im Code berechnet. Dass es sich bei dieser im Bereich P6:P11 stehenden Punkten um die Restpunktzahl handelt wusste ich daher nicht wirklich. Wo hast du denn die Wurf-Punktzahl der Spieler stehen? Wenn diese ebenfalls in einem Bereich untereinander steht, brauchst du nur den Bereich P6:P11 in z.b: U6:U11 anzupassen.  Wenn diese in einer Einzelzelle steht dann beziehst du dich eben z.B. auf Range("AC2").Value oder wo auch immer die Wurf-Punkte stehen.

Wie du im Beispielcode siehst, kannst du die entsprechende Zelle zusammen mit der gewünschten Ansage zu einem Text verknüpfen, den du in Application.Speech.Speak "Text" aufrufst. Ist nicht so schwer.

Und Ja, du kannst gern weitere Fragen stellen. Ob ich oder jemand anderes dir weiterhelfen kann, hängt von der Klarheit deiner Beschreibung ab. Wie gesagt öffne ich eher ungern fremde Dateien.

Gruß Mr. K.

Answer 6

Guten morgen oder guten Tag Mr. K.

kann dich verstehen, mit der Datei, wenn du zufällig M.O. kennst, er ist auch in diesem Forum tätig, kannst du dich gerne bei ihm informieren, das meine Dateien immer sauber sind ohne Vieren etc.. Ich versuche es einmal. Die geworfene Punktzahl erscheinen in den Zellen AD6 bis AD11, hier ist eine Formel hinterlegt =v8-U8. Nun meine Frage: Welche P' s soll ich ersetzen? Aktualisiere die Punkte, Application.Speak , Spielziel oder alle P's?

ich habe alles probiert kriege es nicht hin.

Gruß Adde

Habe etwas vergessen, wenn eine dieser Zellen im Moment P6 bis P11 auf null steht müsste Spielende angesagt werden oder Game Over kann man das noch integrieren?

Answer 7

Hallo Mr. K.

das ist die richtige Datei, 

falls du sie dir doch einmal anschauen möchtest.

https://supportnet.de/forum/?qa=blob&qa_blobid=2188534409880128636

Gruß Adde

Answer 8

Guten Morgen Mr. K.

habe es geschafft. bei Speak Range habe ich von P auf o geändert. Noch eine Frage, könnte man bei diesem Code Sub Spieler Wechsel noch ein Zusatz integrieren das  wenn die Zahl 301 erreicht ist, das die Ansage kommt Spiel ist zu Ende?

Gruß Adde

Answer 9

Hallo Mr. K.

Habe es gelöst.

Das ist das VBA.

Sub Spieler_wechseln()
    Dim AufnahmeErgebnis As Long
    Dim aktiver_Spieler As Long
    Dim Spielende As Boolean
    Dim Zelle As Range

    ' Initialisiere die Variable aktiver_Spieler, falls noch nicht geschehen
    If IsEmpty(Range("T6").Value) Then
        aktiver_Spieler = 1
    Else
        aktiver_Spieler = Range("T6").Value
    End If

    AufnahmeErgebnis = Range("F3").Value + Range("G3").Value + Range("H3").Value
    
    ' Setze die Farbe aller Spieler zurück
    Range("M6:M11").Interior.Color = 15921906
    
    ' Aktualisiere die Punkte und wechsle den aktiven Spieler
    Range("P6:P11").Cells(aktiver_Spieler).Value = Range("P6:P11").Cells(aktiver_Spieler).Value - AufnahmeErgebnis
    
    Application.Speech.Speak Range("AB2").Value & " hat " & Range("O6:O11").Cells(aktiver_Spieler).Value & " Punkte."
    
    ' Überprüfe, ob **irgendein** Spieler das Spiel beendet hat
    Spielende = False
    For Each Zelle In Range("P6:P11")
        If Zelle.Value = 0 Then
            Spielende = True
            Exit For
        End If
    Next Zelle
    
    If Spielende Then
        Application.Speech.Speak "Spiel Ende!"
        Exit Sub
    End If
    
    ' Wechsle zum nächsten Spieler
    aktiver_Spieler = aktiver_Spieler + 1
    If aktiver_Spieler > Range("M22").Value Then aktiver_Spieler = 1
    
    ' Setze die Farbe des aktiven Spielers
    Range("M6:M11").Cells(aktiver_Spieler).Interior.Color = 5287936
    
    ' Zeige die Nummer des aktiven Spielers in Zelle T6 an
    Range("T6").Value = aktiver_Spieler
    
    Application.Speech.Speak Range("AB2").Value & " ist an der Reihe."
End Sub

Grus Adde

Answer 10

Hey Adde,

sehr gut, genauso hätte ich's auch gemacht. So langsam fängst du an, VBA zu verstehen. Wenn du dich weiter rein kniest wird aus dir auch ein Profi. Sorry, dass ich dir gestern nicht antworten konnte, hatte anderweitig zu tun.

Gruß Mr. K.