Viewing the Poker Card as it is Rather than "Ten of Spades"

[sdruley]

Goal is to modify existing code so that the worksheet displays the hand in graphical terms.


01.06.2015-03.32.18 - sdruley's library

Here is the code:

Sub Poker_Coll()     'Uses a collection not a dictionary
    Dim NumCards As Integer, Players As Integer
    Dim Suits(), Cards()
    Dim J As Variant, K As Variant
    Dim CardNum As Integer, i As Integer, v As Integer, CardPick As Integer
    Dim Casino As Collection, CardName As String
    Dim NewSheet   As Worksheet
     
     
    Set Casino = New Collection
     ' number of cards
    NumCards = 7
     ' number of players
    Players = 7
     
    If NumCards * Players > 52 Then
        MsgBox "You have exceeded one deck!", vbCritical
        Exit Sub
    End If
     
    Application.ScreenUpdating = False
     
     'Add a new sheet for the game
    Set NewSheet = ActiveWorkbook.Sheets.Add
     
     'Requires Excel 2000+ to use Array
    Suits = Array("Spades", "Clubs", "Diamonds", "Hearts")
    Cards = Array("Ace", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine", _
    "Ten", "Jack", "Queen", "King")
     
     ' Add the cards to the Collection
    i = 1
    For Each J In Suits
        For Each K In Cards
            Casino.Add K & " of " & J
            i = i + 1
        Next K
    Next J
     
     'Pick a random card, deal it and remove it from the pack
    For i = 1 To Players
        NewSheet.Cells(1, i) = "Player " & i
        For v = 1 To NumCards
            CardPick = Int(Rnd() * Casino.Count + 1)
            CardName = Casino(CardPick)
            NewSheet.Cells(v + 1, i) = CardName
            Casino.Remove (CardPick)
        Next v
    Next i
     
     'dump undealt cards
    v = 1
    NewSheet.Cells(v, i + 1) = "Undealt Cards"
    For Each J In Casino
        v = v + 1
        NewSheet.Cells(v, i + 1) = J
    Next J
     
    NewSheet.UsedRange.EntireColumn.AutoFit
     
    Application.ScreenUpdating = True
     
    Set Casino = Nothing
     
End Sub

Thanks in advance for any assistance on this one

 

[pgc01]

Hi Stephen

I don't have the time now to change the code, but I hope this helps.

Fortunately, Unicode has the characters for the card suits:

Black Spade Suit ♠ , Unicode Character: H2660
Red Heart Suit ♥ , Unicode Character: H2665
Red Diamond Suit ♦ , Unicode Character: H2666
Black Club Suit ♣ , Unicode Character: H2663

This means that you can use them like any other character.

This is an example that writes the 10 of Spades and the Queen of Hearts.
Notice that in the case of Hearts and Diamonds you can also paint the symbol in red.

See if this example helps:

' writes the 10 of Spades and the Queen of Hearts
Sub WriteCards()

' 10 of spades
Range("B1").Value = "10 " & ChrW(&H2660)

' Queen of hearts, use red for the hearts
With Range("B2")
    .Value = "Q " & ChrW(&H2665)
    .Characters(Len(.Value), 1).Font.Color = vbRed
End With

End Sub