Option Explicit
Private LAt As New ListeAleat
'Type Carte: Nom As String: Valeur As Byte: Couleur As Byte: End Type
Private P As Long, OrdNum As Long, Points As Double, derlig As Integer, i As Byte, t
Private Sh As Worksheet, Plage As Range, PointsOrdi As Range, PointsJoueur As Range, _
Pl As Range, cel As Range, celP As Range
'Premier mélange pour la distribution des deux premières cartes.
Sub Tirage_Ordi()
P = 0: OrdNum = 0: Points = 0
Randomize
LAt.Init 52
Call Tirage_Cartes_Ordi
End Sub
'Inscriptions des deux premières cartes de l'ordi dans la feuille "Jeu"
Sub Tirage_Cartes_Ordi()
Dim Chemin As String, fichier As String
Dim Carte
Set Sh = Sheets(1)
With Sh
.Range("f7:h12").ClearContents
Set Plage = .Range("h7:h12")
Set PointsJoueur = .Range("b3")
Set PointsOrdi = .Range("h3")
P = .Cells(6, 6).Row
While P < 8
P = P + 1
Carte = LAt.Aleat(P)
.Cells(P, 7) = CartesOrdi(Carte)
.Cells(P, 6) = Split(.Cells(P, 7), " de")(0)
Select Case .Cells(P, 6)
Case "as": OrdNum = 1
Case "deux": OrdNum = 2
Case "trois": OrdNum = 3
Case "quatre": OrdNum = 4
Case "cinq": OrdNum = 5
Case "six": OrdNum = 6
Case "sept": OrdNum = 7
Case "huit": OrdNum = 8
Case "neuf": OrdNum = 9
Case Else
OrdNum = 10
End Select
.Cells(P, 8) = OrdNum
If Sh.Range("b3") <= 21 And Sh.Range("h3") > Sh.Range("b3") Or _
Sh.Range("h3") > 21 Or Sh.Range("h3") = Sh.Range("b3") Then: Exit Sub
t = Timer + 0.7: Do Until Timer > t: DoEvents: Loop
Wend
PointsOrdi.Value = WorksheetFunction.Sum(Plage)
End With
Select Case Sh.Cells(7, 8).Value
Case Is = 1
Select Case PointsOrdi
Case Is <= 21
PointsOrdi = Val(PointsOrdi) + 10
Case Is > 21
PointsOrdi = Val(PointsOrdi) - 10
End Select
End Select
Select Case Sh.Cells(8, 8).Value
Case Is = 1
Select Case PointsOrdi
Case Is <= 11
PointsOrdi = Val(PointsOrdi) + 10
Case Is > 11
PointsOrdi = Val(PointsOrdi) - 10
End Select
End Select
End Sub
'Inscriptions des cartes restantes dans la feuille "Jeu"
Sub Cartes_Ordi()
Dim Carte
Set Sh = Sheets(1)
With Sh
Set Plage = .Range("h7:h12")
Set PointsOrdi = .Range("h3")
Set PointsJoueur = .Range("b3")
P = .Cells(8, 6).Row
For i = 1 To 4
If PointsJoueur > 21 And PointsOrdi <= 21 Then
Exit Sub
Else
P = P + 1
Carte = LAt.Aleat(P)
.Cells(P, 7) = CartesOrdi(Carte)
.Cells(P, 6) = Split(.Cells(P, 7), " de")(0)
Select Case .Cells(P, 6)
Case "as": OrdNum = 1
Case "deux": OrdNum = 2
Case "trois": OrdNum = 3
Case "quatre": OrdNum = 4
Case "cinq": OrdNum = 5
Case "six": OrdNum = 6
Case "sept": OrdNum = 7
Case "huit": OrdNum = 8
Case "neuf": OrdNum = 9
Case Else
OrdNum = 10
End Select
.Cells(P, 8) = OrdNum
Select Case Sh.Cells(P, 8).Value
Case Is = 1
Select Case PointsOrdi
Case Is <= 21
PointsOrdi = Val(PointsOrdi) + 10
Case Is > 21
PointsOrdi = Val(PointsOrdi) - 10
End Select
End Select
PointsOrdi = WorksheetFunction.Sum(Sh.Range("h7:h12"))
If Sh.Range("b3") <= 21 And Sh.Range("h3") > Sh.Range("b3") Or _
Sh.Range("h3") > 21 Or Sh.Range("h3") = Sh.Range("b3") Then: Exit For
t = Timer + 1: Do Until Timer > t: DoEvents: Loop
End If
Next i
End With
End Sub
Function CartesOrdi(ByVal N As Long) As String
CartesOrdi = Choose((N - 1) Mod 13 + 1, "as", "deux", "trois", "quatre", "cinq", _
"six", "sept", "huit", "neuf", "dix", "valet", "dame", "roi") & " de " & _
Choose((N - 1) \ 13 + 1, "coeur", "carreau", "piques", "trèfle")
End Function
'Function CarteTiree() As Carte
' Dim N As Long: N = LAt.Aleat
' If N = 0 Then MsgBox "Le paquet est épuisé.", vbCritical, "CarteTiree": End
' LAt.Supprimer N
' CarteTiree.Couleur = (N - 1) \ 13 + 1
' N = (N - 1) Mod 13 + 1
' CarteTiree.Nom = Choose(N, "as", "deux", "trois", "quatre", "cinq", _
' "six", "sept", "huit", "neuf", "dix", "valet", "dame", "roi") & " de " & _
' Choose(CarteTiree.Couleur, "coeur", "carreau", "piques", "trèfle")
' CarteTiree.Valeur = IIf(N > 10, 10, N)
' End Function