VBA - Jeu de dé - Pig (le jeu du cochon)

Règles

À chaque tour, un joueur jette un dé à plusieurs reprises jusqu'à ce que :

- soit 1 soit tiré
- ou que le joueur décide de "garder":

• Si le joueur obtient un 1, il ne marque rien et c'est au joueur suivant de jeter le dé,
• Si le joueur obtient un autre nombre, il est ajouté au total de ce tour et le tour du joueur continue.
• Si le joueur choisit de "garder", le total des points du tour est ajouté à son score global, et c'est au joueur suivant de jeter le dé.

Le premier joueur à marquer 100 points ou plus gagne.

Code

Option Explicit

Sub Cochon()
Dim Scs() As Byte, Ask As Integer, Np As Boolean, Go As Boolean
Dim cp As Byte, Rd As Byte, NbP As Byte, ScBT As Byte

    Const INPTXT As String = "Nombre de joueurs : "
    Const INPTITL As String = "Numérique uniquement"
    Const ROL As String = "Joueur ¤¤¤¤ lance le dé."
    Const MSG As String = "Voulez-vous garder votre score : "
    Const TITL As String = "Total si vous gardez : "
    Const RES As String = "Le dé donne : ¤¤¤¤ points."
    Const ONE As String = "Le dé donne : 1 point. Désolé!" & vbCrLf & "Joueur suivant."
    Const WIN As String = "Le joueur ¤¤¤¤ a gagné le jeu du cochon!"
    Const STW As Byte = 100

    Randomize Timer
    NbP = Application.InputBox(INPTXT, INPTITL, 2, Type:=1)
    ReDim Scs(1 To NbP)
    cp = 1
    Do
        ScBT = 0
        Do
            MsgBox Replace(ROL, "¤¤¤¤", cp)
            Rd = Int((Rnd * 6) + 1)
            If Rd > 1 Then
                MsgBox Replace(RES, "¤¤¤¤", Rd)
                ScBT = ScBT + Rd
                If Scs(cp) + ScBT >= STW Then
                    Go = True
                    Exit Do
                End If
                Ask = MsgBox(MSG & ScBT, vbYesNo, TITL & Scs(cp) + ScBT)
                If Ask = vbYes Then
                    Scs(cp) = Scs(cp) + ScBT
                    Np = True
                End If
            Else
                MsgBox ONE
                Np = True
            End If
        Loop Until Np
        If Not Go Then
            Np = False
            cp = cp + 1
            If cp > NbP Then cp = 1
        End If
    Loop Until Go
    MsgBox Replace(WIN, "¤¤¤¤", cp)
End Sub