Příspěvky uživatele

Z toho co jsem četl - ono by to mohlo jít - ale nechtějte po nás, ať si vytváříme soubor, na kterém to budeme zkoušet. Pokud něco máte, šoupněte to sem. Pokud nemáte, něco vytvořte - stačí 20-30 řádků, ať je to na čem testovat. Už byste to asi měl.

@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 ;)

Máte asi novější verzi excelu než já (2007), protože můj nezná událost Workbook_AfterSave

Nejdříve jedna možná nepodstatná technická - není třebaRun "Module1.Pro_Otevrit"stačíCall Module1.Pro_Otevritcompilátor tak lépe ohlídá překlepy v názvech procedur
Pokud jde o zbytek - odpovím přesně na dotaz - děláte něco špatně ;))
A protože jste šikovný, určitě na to chcete přijít sám (já ještě nevím co to je, ale věřím Vám ;) )

2)Teď k mému kódu. Na první pohled to vypadá stejně. Pokud spustíte kód na listu a stisknete mezerník, objeví se hláška a po jejím odkliknutí se přepne do editace buňky. Ano, protože jsem stiskl mezerník a instrukce DoEvents toto umožnila.Zároveň jsem ale přidal požadavek, že pokud dojde ke stisku klávesy, spustí DoEvents proceduru fncKeyboardProc a pokud ta stisknutá klávesa bude mezerník, tak proměnné bEnd (mohl jsem ji nazvat keypressed) přiřadí hodnotu True. A tak dojde k ukončení cyklu - tzn. doplnil jsem ten Váš chybějící krok přiřazení hodnoty. Rozdíl poznáte podle toho, že už nejsounabídky v liště šedivé - u mně se to projevilo až po kliknutí kdekoliv na list. Tzn - kód už neběží.
Procedura fncKeyboardProc se spustí po stisku jakékoliv klávesy a k přerušení dojde pouze při stisku mezerníku (ten jsem si vybral, protože je největší ;) )

@mike55
zkoušel jsem ten kód, ale laicky si stále myslím, že DoEvents prostě zareaguje na událost - stisknutí třeba mezerníku - a ukončí makro
Ne, tak to není a v následujících příspěvcích se Vám (a nejen Vám) to pokusím objasnit

1) - upravil jsem si Váš kód taktoSub test()
Dim i As Long, iMax As Long
i = 0
iMax = 100000

Do
i = i + 1
DoEvents
If Keypressed Or i >= iMax Then
Exit Do
End If
Debug.Print i
Loop
MsgBox "(.....sem už to nikdy nedojde)"
End Suba k MsgBoxu jsem se dostal. Je to proto, že jsem mu zadal alternativní konec cyklu.
Pokud stisknete klávesu na listu bez spuštěného kódu, co se stane? Začne editace buňky.
Pokud spustíte jakýkoliv kód, to se nestane, dokud kód neskončí.
Dal jsem tam DoEvents, čímž jste umožnil systému zpracovat jiné události (stisk klávesy) a tak dál už nepokračuje a ještě k tomu skočí zpět do EXCELU do editace buňky. Už vidíte tu logiku? V tuto chvíli běh kódu neskončil - on běží dál, ale mezitím se Vám excel přepnul do editace buňky. Problém je v tom keypressed - máte ho nedefinované a tak je to proměnná typu Variant a hlavně - nikde mu nepřiřazujete žádnou hodnotu a přitom testujete, zda se rovná True.If Keypressed then Exit DoAle hodnota je Empty a tak se Vám ten kód nikdy nezastaví.

V podstatě si stojím za svou předchozí odpovědí. Excel není stavěný na "nekonečný" cyklus. Ve volnějších chvílích jsem to ze zvědavosti zkoušel a po hledání na netu a v počítači jsem dospěl k následujícímu kódu:Option Explicit

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
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Public Const WH_KEYBOARD As Byte = 2
Public Const VK_SPACE As Byte = &H20

Dim hHook As Long
Dim bEnd As Boolean

Function fncKeyboardProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If idHook < 0 Then
fncKeyboardProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
Else
If &HF0000000 And wParam = &H20 Then
bEnd = True
End If
End If
End Function

Private Sub subTest()
bEnd = False

hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf fncKeyboardProc, Application.Hinstance, GetCurrentThreadId)

Dim i As Long, iMax As Long
i = 0
iMax = 1000000

While Not bEnd And i < iMax
i = i + 1
DoEvents
Wend

If bEnd Then
MsgBox "Space pressed ..."
Else
MsgBox "i = " & iMax
End If

UnhookWindowsHookEx hHook
End Sub
Cyklus běží, dokud i nedosáhne iMax (cca 10s) nebo pokud nestisknu mezerník. Funguje mi to, ale neprovádím žádnou činnost mezi tím. Teoreticky by to fungovat mělo, ale NERUČÍM ZA TO. Je to jen zajímavost a se svou úrovní angličtiny nemůžu tvrdit, že tomu na 100% rozumím (http://msdn.microsoft.com/en-us/library/windows/desktop/ms644990(v=vs.85).aspx)

Osobně bych to asi řešil jinak. Napadá mně napsání prográmku v .NET, který by načítal hodnoty, ukládal je do txt a po skončení by vyvolal nahrání hodnot do excelu. V podstatě by je mohl rovnou házet i do excelu bez txt. Ale mám málo informací o tom co děláte. V každém případě jste nám stále neobjasnil proměnnou keypressed.

1) keypressed = jaký je to typ, odkud bere hodnotu - z toho kousku nic nepoznáme. Pro stisk klávesy byste pravděpodobně musel použít nějakou API funkci.
2) nekonečný cyklus + excel = to podle mně nikdy nebude fungovat spolehlivě. Především si nekonečným cyklem zablokujete celou aplikaci. Raději popište, co to je technologická karta (list v excelu, textový soubor, databáze...) a někdo Vám tady pomůže vymyslet lepší řešení za pomocí integrovaných nástrojů.

Víte - ono to zadání pořád moc jasné není a nebo už začínám být pomalejší ;)

Takže jsem zkusil toto:Sub subAddDocNmbr()
Worksheets("zadat dokument").Protect UserInterfaceOnly:=True

With Sheets("zoznam dokumentov").Range("A1")
If Application.WorksheetFunction.CountIf(.Resize(.CurrentRegion.Rows.Count, 1), Sheets("zadat dokument").Range("B2").Value) > 0 Then
MsgBox "Hodnota už existuje!", vbOKOnly + vbExclamation, ThisWorkbook.Name
Else
If IsEmpty(.Cells(1)) Then
.Value = Sheets("zadat dokument").Range("B2").Value
Else
.Offset(.CurrentRegion.Rows.Count, 0).Value = Sheets("zadat dokument").Range("B2").Value
End If

Sheets("zadat dokument").Range("B2").Value = Sheets("zadat dokument").Range("B2").Value + 1
End If
End With 'Sheets("zoznam dokumentov").Range("A1")
End Sub

Technická poznámka. Na Slovensku měli natolik chytré lidi, aby nepřekládali názvy funkcí, že mně docela překvapilo, když jsem viděl toto: Tlačidlo1_Kliknúť
Vím, že jste si to nevymyslel Vy, ale pokud vytváříte VBA code - vyhněte se diakritice - v 99% to asi vadit nebude, ale i to 1% je hodně, když pak budete muset předělávat celý kód. Tzn - pokud takový píp excel (editor) vytvoří, předělejte to hned.

Co takhle využít kontingenční tabulku.

Hmm - mno zeptám se takhle. Co už jste zkusil? Protože jediné, co vidím já, je žlutě podbarvená buňka s číslem 1. Soubor je xlsx, takže je možné, že jste jej jen špatně uložil...

Jednoduše to vysvětlím asi rovnou do přílohy.
Mno - je to dobrá volba vysvětlit to pomocí přílohy a za to chválím, ale moc se Vám to nepovedlo. Pokud budu mluvit za sebe, tak jsem to vůbec nepochopil a podle množství odpovědí nejsem jediný. Zkuste to znovu a lépe. ;)
Problém nebude složitý, jen je špatně vysvětlen.

Musel bych to vyzobávat ze souboru, takže tohle bylo rychlejší.
Já to dělám takhle:http://youtu.be/O5LyNsFsEgM

@komár
mno já nezkoušel ani jeden kód, tak vás nebudu rozhodcovat ;))
ale tipl bych - nemáte náhodou Office 64 bit - dle mého to nesouvisí s verzí systému, ale office
http://www.jkp-ads.com/articles/apideclarations.asp

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje