Boa noite pessoal,
Estava praticando meu VBA e decidi fazer o jogo Genius, no decorrer do qual me deparei com algumas questões que não consegui solucionar e gostaria da ajuda dos senhores.
1ª: É possível acessar variáveis declaradas como públicas em "EstaPastaDeTrabalho" em rotinas no "Módulo 1"?
2ª: A função BeepAPI funciona corretamente quando as cores são selecionadas manualmente mas não reproduz os sons corretos quando executada automaticamente.
Seguem os códigos:
Sub Workbook_Open()
Dim cores_inicio() As Variant
Dim cores_final() As Variant
Dim a As Integer
Dim vermelho_inicio As Variant
Dim azul_inicio As Variant
Dim verde_inicio As Variant
Dim amarelo_inicio As Variant
Dim vermelho_final As Variant
Dim azul_final As Variant
Dim verde_final As Variant
Dim amarelo_final As Variant
vermelho_inicio = RGB(160, 0, 0)
vermelho_final = RGB(255, 0, 0)
azul_inicio = RGB(0, 0, 160)
azul_final = RGB(0, 0, 255)
verde_inicio = RGB(0, 160, 0)
verde_final = RGB(0, 255, 0)
amarelo_inicio = RGB(160, 160, 0)
amarelo_final = RGB(255, 255, 0)
cores_inicio = Array(vermelho_inicio, azul_inicio, verde_inicio, amarelo_inicio)
cores_final = Array(vermelho_final, azul_final, verde_final, amarelo_final)
a = 0
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 393, 45.75, 90, 33).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "INICIAR"
Selection.ShapeRange.ShapeStyle = msoShapeStylePreset9
Selection.ShapeRange.TextFrame2.TextRange.Font.Size = 20
Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
For i = 0 To 3
ActiveSheet.Shapes.AddShape(msoShapeArc, 400, 114.75, 36, 36).Select
Selection.ShapeRange.Line.Weight = 32
Selection.ShapeRange.ScaleHeight 2, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleWidth 2, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.Line.ForeColor.RGB = cores_inicio(i)
Selection.ShapeRange.Rotation = a
a = a + 90
Next i
Range("A1").Activate
ActiveSheet.Shapes(1).OnAction = "iniciar_Clique"
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ActiveSheet.Shapes.SelectAll
Selection.Delete
End Sub
Public i As Integer
Public a As Integer
Public b As Integer
Public aux As Integer
Public escolha As Integer
Public verdade() As Variant
Public vermelho_inicio As Variant
Public vermelho_final As Variant
Public verde_inicio As Variant
Public verde_final As Variant
Public azul_inicio As Variant
Public azul_final As Variant
Public amarelo_inicio As Variant
Public amarelo_final As Variant
Public cores_inicio() As Variant
Public cores_final() As Variant
Public Declare PtrSafe Function BeepAPI Lib "kernel32" Alias "Beep" (ByVal Frequency As Long, ByVal Milliseconds As Long) As Long
Sub iniciar_Clique()
vermelho_inicio = RGB(160, 0, 0)
vermelho_final = RGB(255, 0, 0)
azul_inicio = RGB(0, 0, 160)
azul_final = RGB(0, 0, 255)
verde_inicio = RGB(0, 160, 0)
verde_final = RGB(0, 255, 0)
amarelo_inicio = RGB(160, 160, 0)
amarelo_final = RGB(255, 255, 0)
cores_inicio = Array(vermelho_inicio, azul_inicio, verde_inicio, amarelo_inicio)
cores_final = Array(vermelho_final, azul_final, verde_final, amarelo_final)
i = 0
b = 0
Call nova_cor
ActiveSheet.Shapes(2).OnAction = "vermelho_Clique"
ActiveSheet.Shapes(3).OnAction = "azul_Clique"
ActiveSheet.Shapes(4).OnAction = "verde_Clique"
ActiveSheet.Shapes(5).OnAction = "amarelo_Clique"
End Sub
Sub nova_cor()
Application.ScreenUpdating = True
Application.Wait (Now + TimeValue("0:00:01"))
aux = Application.WorksheetFunction.RandBetween(2, 5)
ReDim Preserve verdade(i)
verdade(i) = aux
For a = LBound(verdade) To UBound(verdade)
ActiveSheet.Shapes.Range(Array(verdade(a))).Line.ForeColor.RGB = cores_final(verdade(a) - 2)
Application.ScreenUpdating = True
Application.Wait (Now + TimeValue("0:00:01"))
Call Beep
ActiveSheet.Shapes.Range(Array(verdade(a))).Line.ForeColor.RGB = cores_inicio(verdade(a) - 2)
Application.ScreenUpdating = True
Application.Wait (Now + TimeValue("0:00:01"))
Next a
End Sub
Sub seleciona_cor()
If escolha = verdade(b) Then
b = b + 1
If b > UBound(verdade) Then
i = i + 1
Call nova_cor
b = 0
Exit Sub
End If
Else
MsgBox "Errou!"
ActiveSheet.Shapes.Range(Array(2, 3, 4, 5)).Select
Selection.OnAction = ""
Range("A1").Activate
ReDim verdade(0)
End If
End Sub
Sub vermelho_Clique()
ActiveSheet.Shapes.Range(Array("Arco 2")).Line.ForeColor.RGB = cores_final(0)
Application.ScreenUpdating = True
Application.Wait (Now + TimeValue("0:00:01"))
BeepAPI 523.25, 500
ActiveSheet.Shapes.Range(Array("Arco 2")).Line.ForeColor.RGB = cores_inicio(0)
escolha = 2
Call seleciona_cor
End Sub
Sub azul_Clique()
ActiveSheet.Shapes.Range(Array("Arco 3")).Line.ForeColor.RGB = cores_final(1)
Application.ScreenUpdating = True
Application.Wait (Now + TimeValue("0:00:01"))
BeepAPI 587.33, 500
ActiveSheet.Shapes.Range(Array("Arco 3")).Line.ForeColor.RGB = cores_inicio(1)
escolha = 3
Call seleciona_cor
End Sub
Sub verde_Clique()
ActiveSheet.Shapes.Range(Array("Arco 4")).Line.ForeColor.RGB = cores_final(2)
Application.ScreenUpdating = True
Application.Wait (Now + TimeValue("0:00:01"))
BeepAPI 659.25, 500
ActiveSheet.Shapes.Range(Array("Arco 4")).Line.ForeColor.RGB = cores_inicio(2)
escolha = 4
Call seleciona_cor
End Sub
Sub amarelo_Clique()
ActiveSheet.Shapes.Range(Array("Arco 5")).Line.ForeColor.RGB = cores_final(3)
Application.ScreenUpdating = True
Application.Wait (Now + TimeValue("0:00:01"))
BeepAPI 698.46, 500
ActiveSheet.Shapes.Range(Array("Arco 5")).Line.ForeColor.RGB = cores_inicio(3)
escolha = 5
Call seleciona_cor
End Sub
Sub Beep()
Select Case aux
Case 2: BeepAPI 523.25, 500
Case 3: BeepAPI 587.33, 500
Case 4: BeepAPI 659.25, 500
Case 5: BeepAPI 698.46, 500
End Select
End Sub
Att, Televisaos
Postado : 04/11/2020 6:27 pm