MS Excel

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

Zaslal/a mike55 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

mike55(19.11.2014 17:36)#022416

Tak už to funguje. Každopádně dík všem, kdo jste mi pomohli "nekonečný cyklus" přerušit.

citovat

lubo(19.11.2014 19:02)#022419

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

lubo(19.11.2014 19:17)#022420

@eLCHa

Chybělo jen:

fncKeyboardProc = 1 (něco kladného)

+ možná u api bezpečnější deklaracecitovat

eLCHa(20.11.2014 12:00)#022442

@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

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

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje