SampleApp/VBA-Code/CodeModule.txt

Public Const board1 = "{5}"
Public Const board2 = "{6}"

Public Const userShip1 = "{0}"
Public Const userShip2 = "{1}"
Public Const userShip3 = "{2}"
Public Const userShip4 = "{3}"
Public Const userShip5 = "{4}"

Global g_logRow As Integer
Global g_gameEnded As Boolean
Global g_Ships As Collection
Global g_userShips As Collection
Public Function Collide(r1 As Range, r2 As Range) As Boolean
If r1.row + r1.Rows.Count > r2.row And r1.row < r2.row + r2.Rows.Count And _
      r1.column + r1.Columns.Count > r2.column And r1.column < r2.column + r2.Columns.Count Then
      Collide = True
Else
    Collide = False
End If
End Function
Public Sub AddShips(board As Range)
    Set g_Ships = New Collection
    
    Dim s1 As New Ship
    
    s1.Size = 5
    Set s1.Position = GetShipPos(board, s1.Size)
    g_Ships.Add s1, "carrier"
    
    Dim s2 As New Ship
    s2.Size = 4
    Set s2.Position = GetShipPos(board, s2.Size)
    g_Ships.Add s2, "battleship"

    Dim s3 As New Ship
    s3.Size = 3
    Set s3.Position = GetShipPos(board, s3.Size)
    g_Ships.Add s3, "sub"

    Dim s4 As New Ship
    s4.Size = 3
    Set s4.Position = GetShipPos(board, s4.Size)
    g_Ships.Add s4, "cruiser"

    Dim s5 As New Ship
    s5.Size = 2
    Set s5.Position = GetShipPos(board, s5.Size)
    g_Ships.Add s5, "destroyer"
End Sub
Public Sub AddUserShips(board As Range)
    Set g_userShips = New Collection
    
    Dim s1 As New Ship
    
    s1.Size = 5
    Set s1.Position = Battleship.Range(userShip1)
    g_userShips.Add s1, "carrier"
    
    Dim s2 As New Ship
    s2.Size = 4
    Set s2.Position = Battleship.Range(userShip2)
    g_userShips.Add s2, "battleship"

    Dim s3 As New Ship
    s3.Size = 3
    Set s3.Position = Battleship.Range(userShip3)
    g_userShips.Add s3, "sub"

    Dim s4 As New Ship
    s4.Size = 3
    Set s4.Position = Battleship.Range(userShip4)
    g_userShips.Add s4, "cruiser"

    Dim s5 As New Ship
    s5.Size = 2
    Set s5.Position = Battleship.Range(userShip5)
    g_userShips.Add s5, "destroyer"
End Sub
Public Function GetShipPos(board As Range, ByVal Size As Integer) As Range
    Dim row As Integer, column As Integer
    Dim Horizontal As Integer
    
    Do
        Randomize
        row = (Rnd * (board.Rows.Count - 1)) + 1
        column = (Rnd * (board.Rows.Count - 1)) + 1
        Horizontal = Rnd
    
        If Horizontal = 1 Then
            If column - Size > 0 And column + Size < 10 Then
                If Rnd = 0 Then
                        Set GetShipPos = board.Range(Cells(row, column), Cells(row, column + Size - 1))
                Else
                        Set GetShipPos = board.Range(Cells(row, column - Size + 1), Cells(row, column))
                End If
            ElseIf column - Size > 0 Then
                Set GetShipPos = board.Range(Cells(row, column - Size + 1), Cells(row, column))
            Else
                Set GetShipPos = board.Range(Cells(row, column), Cells(row, column + Size - 1))
            End If
        Else
            If row - Size > 0 And row + Size < 10 Then
                If Rnd = 0 Then
                        Set GetShipPos = board.Range(Cells(row, column), Cells(row + Size - 1, column))
                Else
                        Set GetShipPos = board.Range(Cells(row - Size + 1, column), Cells(row, column))
                End If
            ElseIf row - Size > 0 Then
                Set GetShipPos = board.Range(Cells(row - Size + 1, column), Cells(row, column))
            Else
                Set GetShipPos = board.Range(Cells(row, column), Cells(row + Size - 1, column))
            End If
        End If
    Loop Until ValidSpot(GetShipPos)
End Function
'Make sure the spot isn't occupied
Private Function ValidSpot(r As Range) As Boolean
    Dim oShip As Ship
    For Each oShip In g_Ships
        If Code.Collide(r, oShip.Position) Then
            ValidSpot = False
            Exit Function
        End If
    Next
    ValidSpot = True
End Function

Public Sub SetHit(Target As Range)
    Target.Worksheet.Unprotect
    With Target.Borders(xlDiagonalDown)
     .LineStyle = xlContinuous
     .Color = ColorConstants.vbBlack
     .TintAndShade = 0
     .Weight = xlMedium
    End With
    With Target.Borders(xlDiagonalUp)
     .LineStyle = xlContinuous
     .Color = ColorConstants.vbBlack
     .TintAndShade = 0
     .Weight = xlMedium
    End With
    Target.Worksheet.Protect ""
End Sub
Public Function CheckWinner(ships As Collection) As Boolean
    Dim oShip As Ship
    For Each oShip In ships
        If oShip.Hits.Count < oShip.Position.Cells.Count Then
            CheckWinner = False
            Exit Function
        End If
    Next
    CheckWinner = True
End Function