< návrat zpět

MS Excel


Téma: VBA - pokračování po DoEvents rss

Zaslal/a 17.11.2014 22:39

Tlačítkem spouštím makro - nekonečný cyklus Do..Loop, který načítá neustále hodnoty z technologické karty. Potřebuji stiskem klávesy cyklus přerušit a pokračovat za Loop. Dal jsem tam DoEvents, ale to ukončí celé makro, dál už nepokračuje a ještě k tomu skočí zpět do EXCELU do editace buňky(tzn. nabídky v liště šedivé) a čeká na zápis do buňky.
Jde to přerušit nějak jinak?
Nebo aspoň, aby se to vrátilo "normálně" do EXCELU bez nutnosti potvrdit?
---
Do
DoEvents
If Keypressed then Exit Do
Call XXX
Loop
MsgBox(.....sem už to nikdy nedojde)
End Sub

Zaslat odpověď >

Strana:  « předchozí  1 2 3
#022416
avatar
Tak už to funguje. Každopádně dík všem, kdo jste mi pomohli "nekonečný cyklus" přerušit. 5citovat
#022419
avatar
Ještě jedna varianta (zastavuje na libovolnou klávesu a klávesu dál nepustí)


Option Explicit

Const WH_KEYBOARD = 2

#If VBA7 Then
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
#Else
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
#End If

Dim bEnd As Boolean

Sub Pokus3()
Dim cc As String
Dim hHook As Long

Cells(1, 1).Value = 0 ' Ať to něco dělá
bEnd = False

hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeyboardProc, &H0, GetCurrentThreadId)
Do Until bEnd
DoEvents
Cells(1, 1).Value = Cells(1, 1).Value + 1
Loop
UnhookWindowsHookEx hHook

MsgBox "konec"
End Sub

Function KeyboardProc(ByVal iCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If iCode < 0 Then
KeyboardProc = CallNextHookEx(0, iCode, wParam, lParam)
Else
bEnd = True
KeyboardProc = 1
End If
End Function


Testováno na 32 bit. Nevylučuji problémy na 64 bit.citovat
#022420
avatar
@eLCHa

Chybělo jen:

fncKeyboardProc = 1 (něco kladného)

+ možná u api bezpečnější deklaracecitovat
icon #022442
eLCHa
@lubo
díky za dotažení ;)
ve středu už jsem neměl čas a pak už se mi nad tím nechtělo přemýšlet ;)
Schovám si to kdyby náhodou, protože jsem na netu žádné řešení nenašel. I když to pravděpodobně nikdy nepoužiju ;)citovat

Strana:  « předchozí  1 2 3

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

odpocet a storno tl.

PavDD • 28.3. 8:53

odpocet a storno tl.

Začátečník • 26.3. 14:39

odpocet a storno tl.

PavDD • 26.3. 10:22

odpocet a storno tl.

elninoslov • 26.3. 7:50

odpocet a storno tl.

PavDD • 26.3. 7:26

odpocet a storno tl.

elninoslov • 25.3. 22:34

odpocet a storno tl.

Začátečník • 25.3. 15:09