Geek tričko zdarma Geek tričko zdarma
Tričko zdarma! Stačí před dobitím bodů použít kód TRIKO15. Více informací zde

Diskuze: VBA AZ-Kvíz

Aktivity (1)
Avatar
hermytch
Člen
Avatar
hermytch:28. března 19:30

Ahoj, snažím se ve VBA v excelu vyrobit losování o výhru podobně jako je to v AZ kvízu. Tzn. 19 polí uspořádaných v šestiúhelníku. Jejich barva se mění po vteřině a uživatel by měl mít možnost tento průběh kdykoliv zastavit. Povedlo se mi pomocí cyklu to udělat, aby se měnila barva polí, ale kvůli tomu, že to běží v cyklu, tak to nejde zastavit, protože nelze jako uživatel nijak zasáhnout.
Cyklus vypadá takhle:
For i = 1 To 19
List1.Shapes(i)­.Fill.Forecolor­.RGB = RGB(237,125,49)
Application.Wait Now + TimeSerial(0,0,1)
List1.Shapes(i)­.Fill.Forecolor­.RGB = RGB(0,191,255)
Next i

Zkusil jsem: Zkoušel jsem dát různé checkboxy a ověření pokud je zaškrtnutý tak zastavit cyklus, ale během cyklu nemohu měnit hodnotu checkboxu

Chci docílit: Možnost zastavit cyklus (měnění barev polí) kdykoliv chce uživatel

 
Odpovědět 28. března 19:30
Avatar
zitekv
Člen
Avatar
Odpovídá na hermytch
zitekv:29. března 0:15

DoEvents dovolí v sešitu "pracovat"
Funkce GetAsyncKeyState odychytává stisknuté klávesy a vrací True v případě shody.

  Private Declare Function GetAsyncKeyState Lib "user32" _
            (ByVal vKey As Long) As Integer

Private Const VK_F9 = &H78
Sub Makro1()
WaitUntilF9Key
End Sub
Sub WaitUntilF9Key()
cas = Now
start_cas = cas
Do Until GetAsyncKeyState(VK_F9)
    DoEvents
If Now > cas + TimeSerial(0, 0, 1) Then
    cas = Now
    start
    End If
Loop
ukoncit = True
MsgBox "Vybrane policko " & Cells(1, 1).Value - 1 & "!"
End Sub
Sub start()
  poradi = Cells(1, 1).Value
  If poradi > 19 Then
  Cells(1, 1).Value = 1
  poradi = 1
  End If
List1.Shapes(poradi).Fill.ForeColor.RGB = RGB(237, 125, 49)
If poradi > 1 Then
List1.Shapes(poradi - 1).Fill.ForeColor.RGB = RGB(0, 191, 255)
Else
List1.Shapes(19).Fill.ForeColor.RGB = RGB(0, 191, 255)
End If
Cells(1, 1).Value = poradi + 1
End Sub
Editováno 29. března 0:16
 
Nahoru Odpovědět 29. března 0:15
Avatar
hermytch
Člen
Avatar
Odpovídá na zitekv
hermytch:29. března 7:08

Díky! Jen to po mně chce GetAsyncKeyState upravit do 64 bit, lze to nějak převést?

 
Nahoru Odpovědět 29. března 7:08
Tento výukový obsah pomáhají rozvíjet následující firmy, které dost možná hledají právě tebe!
Avatar
zitekv
Člen
Avatar
Odpovídá na hermytch
zitekv:29. března 8:39

Zkus tohle - já mám 32bit Excel, tak jsem to neřešil.

#If VBA7 Then
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
#Else
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
#End If
 
Nahoru Odpovědět 29. března 8:39
Avatar
hermytch
Člen
Avatar
Odpovídá na zitekv
hermytch:29. března 8:47

Už to funguje. Chápu správně, že stisknutí F9 mi program pozastaví a já můžu něco předělat? Sub start() jsem přiřadil Commandbuttonu, ale jelikož je pokaždé nutné kliknout, aby se pole přebarvila, tak potom F9 postrádá smysl. Je to tak nebo to nechápu správně?

 
Nahoru Odpovědět 29. března 8:47
Děláme co je v našich silách, aby byly zdejší diskuze co nejkvalitnější. Proto do nich také mohou přispívat pouze registrovaní členové. Pro zapojení do diskuze se přihlas. Pokud ještě nemáš účet, zaregistruj se, je to zdarma.

Zobrazeno 5 zpráv z 5.