[VBA] – Criando um jogo de tiro ao alvo no Excel

Tempo de leitura: 3 minutos

Fala galera, segue nossa primeira série de videos de como desenvolver jogos em Excel usando os recursos do VBA.

Nesse primeiro jogo vamos aprender a desenvolver um jogo de tiro ao alvo usando 100% do Excel com os recursos do VBA.

Nesse jogo você vai aprender a usar o poderoso componente Shapes e a função VBA.DoEvents.

Todas as aulas estão disponíveis também no nossa canal do youtube. Não deixem de se inscrever lá.

Aula 1 – Desenvolvendo o cenário do jogo

Aula 2 – Configurando as funções reset e pause do jogo

Aula 3 – Configurando a função para iniciar o jogo

Aula 4 – Configurando as funções de atirar e derrubar o coco.

Código do Jogo

Dim sh As Worksheet
Dim gamesh As Worksheet

Dim bala As Shape
Dim coco As Shape


Sub Resetar()

    Set sh = ThisWorkbook.Sheets("Config")
    Set gamesh = ThisWorkbook.Sheets("Jogo")
    
    Set bala = gamesh.Shapes("Bala")
    Set coco = gamesh.Shapes("Coco")
    

    bala.Top = 211.43
    bala.Left = 161.81
    coco.Top = 76.43
    coco.Left = 579.31
    
    sh.Range("C2:c3").Value = "Stop"
    
    sh.Range("d2").Value = 0
    sh.Range("d3").Value = 10


End Sub

Sub Play_Game()

    Set sh = ThisWorkbook.Sheets("Config")
    Set gamesh = ThisWorkbook.Sheets("Jogo")
    
    Set bala = gamesh.Shapes("Bala")
    Set coco = gamesh.Shapes("Coco")
    
    
    sh.Range("c2").Value = "Move"
    
 
    
    
x:
    
    VBA.DoEvents
    
    If sh.Range("c2").Value = "Stop" Then Exit Sub
    
    coco.Top = coco.Top + sh.Range("b2").Value
    
    If coco.Top > 365.18 Then coco.Top = 76.43
    
    
GoTo x
    



End Sub

Sub Pause_Game()

    Set sh = ThisWorkbook.Sheets("Config")
    Set gamesh = ThisWorkbook.Sheets("Jogo")
    
    Set bala = gamesh.Shapes("Bala")
    Set coco = gamesh.Shapes("Coco")
    
    sh.Range("c2:c3").Value = "Stop"


End Sub


Sub shoot()

    Set sh = ThisWorkbook.Sheets("Config")
    Set gamesh = ThisWorkbook.Sheets("Jogo")
    
    Set bala = gamesh.Shapes("Bala")
    Set coco = gamesh.Shapes("Coco")
    
    If sh.Range("c2").Value = "Stop" Then
    
        MsgBox "Clique em iniciar primeiro"
        Exit Sub
        
    End If
    
     If sh.Range("d3").Value = 0 Then
    
        MsgBox "Você não tem mais bala, clique em iniciar"
        Exit Sub
        
    End If
    
    
    
    sh.Range("c3").Value = "Move"
    
x:
    
    VBA.DoEvents
    
    If sh.Range("c2").Value = "Stop" Then Exit Sub
    
    coco.Top = coco.Top + sh.Range("b2").Value
    
    If coco.Top > 365.18 Then coco.Top = 76.43
    
    If sh.Range("c3").Value = "Stop" Then Exit Sub
    
        bala.Left = bala.Left + sh.Range("b3").Value
        
    If bala.Left > 560 And bala.Left < 570 Then
    
        If coco.Top > 184 And coco.Top < 206 Then
        
            Call Drop_coco
        
        End If
    
    
    End If
    
    
    If bala.Left > 1157 Then
    
        sh.Range("C3") = "Stop"
        sh.Range("D3") = sh.Range("d3") - 1
        bala.Top = 211.43
        bala.Left = 161.81
        
        
    
    
    End If
        
    
    
GoTo x
    
    
    


End Sub


Sub Drop_coco()

    Set sh = ThisWorkbook.Sheets("Config")
    Set gamesh = ThisWorkbook.Sheets("Jogo")
    
    Set bala = gamesh.Shapes("Bala")
    Set coco = gamesh.Shapes("Coco")
    
    Dim coco1 As Shape
    Dim coco2 As Shape
    
    
    Set coco1 = gamesh.Shapes("coco1")
    Set coco2 = gamesh.Shapes("coco2")

    sh.Range("c2:c3").Value = "stop"
    
    bala.Top = 211.43
    bala.Left = 161.81
    coco.Top = 76.43
    coco.Left = 579.31
    
    coco1.Top = 186
    coco1.Left = 585.75
    coco2.Top = 221.99
    coco2.Left = 580.06
    
x:
    VBA.DoEvents
    
    coco1.Top = coco1.Top + sh.Range("b2").Value
    
    coco2.Top = coco2.Top + sh.Range("b2").Value
    coco2.Left = coco2.Left + sh.Range("b3").Value
    
    If coco1.Top > 369 Then
    
        sh.Range("D2").Value = sh.Range("d2") + 1
        Exit Sub
    
   End If
   
GoTo x
   


End Sub

Deixe uma resposta

O seu endereço de e-mail não será publicado. Campos obrigatórios são marcados com *