Discussion :

[yaomoreau]

Bonjour
J'ai créé un petit compteur sur une feuille afin de limiter le temps de réponse au xquestion de cette feuille, mais durant le décompte le compteur me bloque et je ne peux rien faire. Si quelqu'un pouvait me dire quel code ou macro peut libérer l'écran pendant ce temps afin de pouvoir répondre aux questions de la feuille cela serait super et les enfants seraient ravis.
Merci à tous

[laetitia]

bonjour yaomoreau le forum comme cela pas simple sans plus d'infos comment se presente ton programme???
un exemple basique tu lance la macro puis si a1 vide a bout de 9 secondes message a adapter. surement passer par une evementielle pour lancer la macro en automaique a voir????

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Option Explicit
Sub Tempo()
Dim fin As Variant
fin = Timer + 9: Do While Timer < fin: DoEvents:  Loop
If [a1] = "" Then MsgBox "temps ecoule"
End Sub

fait aussi une recherche sur La méthode OnTime tres interessant

[babybell]

Bonjour yaomoreau, le forum,laetitia.

Voilà un petit code à adapter qui en plus fait apparaître le Chrono dans la barre d'2tat.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Private Declare Function FindWindow& Lib "user32" Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function FindWindowEx& Lib "user32" Alias "FindWindowExA" (ByVal hWnd1&, ByVal hWnd2&, ByVal lpsz1$, ByVal lpsz2$)
Private Declare Function GetDC& Lib "user32" (ByVal hwnd&)
' New color
Private Declare Function GetTextColor& Lib "gdi32" (ByVal hdc&)
Private Declare Function SetTextColor& Lib "gdi32" (ByVal hdc&, ByValcrColor&)
' New police
Private Declare Function CreateFont& Lib "gdi32" Alias "CreateFontA" (ByVal nHeight&, ByVal nWidth& _
, ByVal nEscapement&, ByVal nOrientation&, ByVal fnWeight& _
, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean _
, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet& _
, ByVal fdwOutputPrecision&, ByVal fdwClipPrecision& _
, ByVal fdwQuality&, ByVal fdwPitchAndFamily&, ByVal lpszFace$)
Private Declare Function SelectObject& Lib "gdi32" (ByVal hdc&, ByVal hObject&)
Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject&)
Private Declare Function ReleaseDC& Lib "user32" (ByVal hwnd&, ByVal hdc&)
Sub timer_off()
Dim BarState As Boolean, hwnd&, hdc&, hFont&, hObj&, Color&
Dim start
Dim S As Byte
PauseTime = 300
BarState = Application.DisplayStatusBar
Application.DisplayStatusBar = True
hwnd = FindWindow(vbNullString, Application.Caption)
hwnd = FindWindowEx(hwnd, ByVal 0&, "EXCEL4", vbNullString)
hdc = GetDC(hwnd)
Color = GetTextColor(hdc)
SetTextColor hdc, RGB(255, 0, 0)
hFont = CreateFont(-16, 0, 0, 0, 700, 1, 0, 0, 0, 0, 0, 0, 1, "Times NewRoman ")
hObj = SelectObject(hdc, hFont)
 
start = Timer
        Do While Timer < start + PauseTime
           If S <> Second(Time) Then
Application.StatusBar = "                                                       " & Format(100 * Int((start + PauseTime - Timer) / 60) + Int((start + PauseTime - Timer) Mod 60), "00:00")
        S = Second(Time)
        End If
        DoEvents
    Loop
End Sub