Nové výhodné předplatné namísto kreditů je tu! Více informací. Upravili jsme také naše provozní podmínky.
NOVINKA: Staň se datovým analytikem a získej jistotu práce, lepší plat a nové kariérní možnosti. Více informací:
Avatar
Lukáš
Člen
Avatar
Lukáš:28.3.2019 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.3.2019 19:30
Avatar
zitekv
Člen
Avatar
Odpovídá na Lukáš
zitekv:29.3.2019 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
 
Nahoru Odpovědět
29.3.2019 0:15
Avatar
Lukáš
Člen
Avatar
Odpovídá na zitekv
Lukáš:29.3.2019 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.3.2019 7:08
Avatar
zitekv
Člen
Avatar
Odpovídá na Lukáš
zitekv:29.3.2019 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.3.2019 8:39
Avatar
Lukáš
Člen
Avatar
Odpovídá na zitekv
Lukáš:29.3.2019 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.3.2019 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.