Publicado em 1 comentário

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

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
Publicado em Deixe um comentário

[Jogo] – Tiro ao Alvo no Excel

Fala galera, segue mais um jogo clássico feito 100% em Excel, usando os recursos do VBA.

Se você quiser aprender a desenvolver o jogo clique aqui

Download link abaixo

Curso de como desenvolver o jogo

Código VBA

Dim sh As Worksheet
Dim gamesh As Worksheet

Dim bala As Shape
Dim coco As Shape


Sub Reset()

    Set sh = ThisWorkbook.Sheets("Config")
    Set gamesh = ThisWorkbook.Sheets("Jogo")
    
    Set bala = gamesh.Shapes("Bala")
    Set coco = gamesh.Shapes("Coco")
    
    Dim sp As Shape
    Set sp = gamesh.Shapes("Bala e Coco")
    
    Dim sp1 As Shape
    Set sp1 = gamesh.Shapes("Coco2")
    
    Dim sp2 As Shape
    Set sp2 = gamesh.Shapes("Coco3")
    
    bala.Top = 228.75
    bala.Left = 159
    coco.Top = 94.5
    coco.Left = 532.5
    
    sp.Top = 471
    sp.Left = 564.75
    
    sp1.Top = 471
    sp1.Left = 564.75
    
    sp2.Top = 471
    sp2.Left = 564.75
    
    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")
    
    Dim sp As Shape
    Set sp = gamesh.Shapes("Bala e 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 > 400 Then coco.Top = 94.5
    
    
    GoTo x


End Sub

Sub Pause_Game()

    Set sh = ThisWorkbook.Sheets("Config")
    
    sh.Range("c2:C3").Value = "Stop"

End Sub

Sub Shoot()

    Set sh = ThisWorkbook.Sheets("Config")
    Set gamesh = ThisWorkbook.Sheets("Jogo")
    
    If sh.Range("C2").Value = "Stop" Then
    
        MsgBox "Clique em inicar primeiro"
        Exit Sub
        
    End If
    
    If sh.Range("d3").Value = "0" Then
    
        MsgBox "Você não tem mais bala" & vbLf & vbLf & "Clique no botão reiniciar"
        Exit Sub
        
    End If
    
    
    Set bala = gamesh.Shapes("Bala")
    Set coco = gamesh.Shapes("Coco")
    
    Dim sp As Shape
    Set sp = gamesh.Shapes("Bala e Coco")
    
    sh.Range("c3").Value = "Move"
    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 > 300 Then coco.Top = 94.5
    
    
    If sh.Range("c3").Value = "Stop" Then Exit Sub
    
        bala.Left = bala.Left + sh.Range("B3").Value
    
    If bala.Left > 530 And bala.Left < 540 Then
    
        If coco.Top > 201 And coco.Top < 223 Then
            
            Call Drop_coco
            
            Call Play_Game
        
        End If
    
    End If
    
    If bala.Left > 1000 Then
    
        sh.Range("c3").Value = "Stop"
        sh.Range("D3").Value = sh.Range("D3").Value - 1
        bala.Top = 228.75
        bala.Left = 159
     
    
    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 sp As Shape
Set sp = gamesh.Shapes("Bala e Coco")

Dim sp1 As Shape
Set sp1 = gamesh.Shapes("Coco2")

Dim sp2 As Shape
Set sp2 = gamesh.Shapes("Coco3")

sh.Range("c2:c3").Value = "Stop"

bala.Top = 228.75
bala.Left = 159
coco.Top = 94
coco.Left = 532

'sp.Top = 213.85
'sp.Left = 555.1

sp1.Top = 238
sp1.Left = 546.75

sp2.Top = 206.12
sp2.Left = 543.9

x:

VBA.DoEvents

'sp.Top = sp.Top + sh.Range("b2").Value
'sp.Left = sp.Left + sh.Range("b3").Value

sp1.Top = sp1.Top + sh.Range("b2").Value
'sp1.Left = sp1.Left + sh.Range("b3").Value

sp2.Top = sp2.Top + sh.Range("b2").Value
sp2.Left = sp2.Left + sh.Range("b3").Value

If sp1.Top > 380 Then

    sh.Range("d2").Value = sh.Range("d2").Value + 1
    Exit Sub
End If

GoTo x

End Sub