Discussion :

[david_atx]

Bonjour le forum, cela fait quelques temps que je n'avais pas poser de questions.

ALors vilà ce que j'aimerais faire.
J'ai dans une application un userform qui me sert de timer ou dans un autre cas d'indicateur de température.
Bref là n'est pas l'important.
Toujours est il qe pendant un temps donné ce userform est affiché et il faut qu'un de ces labels soit mis à jour en fonction d'une valeur externe.

J'avais trouvé donc cette solution

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
Public Function compte_a_rebours(Duree)
 
debut = Timer
 
fin = Duree + debut
tim.Show vbModeless
 
For i = 0 To Duree
 
t = Timer - debut
While Not t >= i
t = Timer - debut
Wend
t = Duree - t
t = SecondeEnHeure(t)
tim.Label2.Caption = t: DoEvents
tim.Repaint
Next i
 
Unload tim
 
End Function

Qui fait ce que je lui demande a ceci prêt que je suis obligé de mettre mon userform en non modal et la ca m'embete !
Je voudrais que mon userform soit modal ou tout du moins que la personne n'est pas accès à la feuille Excel (enfin tout du moins qu'il ne puisse aps interagir avec)

Si quelqu'un à une idée je suis preneur

[LeForestier]

Bonjour,
Comprend pas, pourquoi ça ne va pas en Modal, puisque tu ne veux pas que l'utilisateur puisse agir ?
A+

[david_atx]

le problème du modal c'est que le label ne se met pas a jour ...
Et je ne voi pas pourquoi d'ailleurs

[Didier Gonard]

Bonjour,

Sans analyser le fond, pour répondre à ta question , tu peux peut-être regarder du côté de la propriété Interactive de l'objet Application :

Code :

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

Application.Interactive = False  ' True

vois l'aide vba....

cordialement,

Didier

[LeForestier]

Tu peu tester ce code..

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
'Duree en seconde
Public Sub Delais(Duree As Integer)
Dim S As Integer
Dim debut As Integer, fin As Integer
    S = Second(Now)
    Label2.Caption = Duree
    Do
        If S <> Second(Now) Then
            Duree = Duree - 1
            Label2.Caption = Duree
            S = Second(Now)
        End If
        DoEvents
    Loop While Duree > 0
End Sub

A+

[david_atx]

toujours le meme problème a savoir qu'il faut mettre l'usf en modeless pour que ca marche

Mais c'est pas grave je vais utiliser ta solution ca mine de rien c'est moins gourmand en ressources et a coté de ca je vais mettre le application.interaction à false ce qui semble convenir

Merci à vous deux je test et je mets résolu ensuite

[LeForestier]

Mais pas du tout, j'ai mis la sub dans l'UF et ouvert l'UF en modal et le label se rafraichi.
Ton label, il est sur l'UF ?

[david_atx]

1) désolé pour le double post ca fait up en meme temps

2) Petite question à Le forestier :
As tu testé ce code ou non pour savoir si c'est moi qui bidouille mal ou pas
et tu me conseilles de le mettre où ? dans un module classique ou dans le code de l'usf ?

edit bon j'ai écris en meme temps que ton dernier message ...
je savais que je merdais quelque part

et tu la met ou dans l'UF ?
uf_initialise ?

[LeForestier]

non, tu copie la sub comme elle est dans le module de l'UF.
et dans Activate tu met

Code :

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

Delais 20 'par exemple pour 20 seconde

si tu met dans initialise l'UF ne s'affiche jamais.
C'est probablement pour ça que tu ne voyais pas ton label.
A+

[david_atx]

oui j'ai fait les test et je m'en suis rendu compte
au passage si tu mets dans initialise le delais 20 ca s'affiche mais au bout des 20 secondes

et merci hein

[david_atx]

J'ai enlevé la balise résolue car je viens de découvrir un nouveau petit problème.
En effet en utilisant la fonction de notre cher ami forestier , il se pose un problème certes pas très important mais tout de meme :

Quand on clique sur le userform (tout en maintenant appuyé) le compteur s'arrète gentiment de tourner et lorsqu'on le lache il ne rattrape pas le temps passé

Impossible de mettre enabled à false car sinon le label ne se met plus à jour
l'astuce du application.interactive ne marche pas non plus.

Et là j'avoue je sèche ...
Bon évidemment dans l'absolu faut que le user aille faire ca et donc il est pas bien malin s'il le fait et ca ne va pas décaller de beaucoup mais je suis tatillon

quelqu'un a une idée ?

edit : quand je dis cliquer sur le userform je parle de sa barre de titre bien entendu !

[david_atx]

bon j'ai trouvé une solution qui fait ce que je veux
je la poste demain la j'ai pas le temps je décolle

[LeForestier]

Si tu a trouver une solution c'est OK, sinon regarde dans cette contrib, tu peu tout simplement enlever la barre de titre, comme ça l'User (comme tu dis) ne pourra même pas déplacer l'UF.
A+

[david_atx]

j'ai fait l'équivalent
mais je testerais ta solution qui est peut etre encore mieux

Voici celle que j'ai trouvé en farfouillant sur le world wide web :

Décalrations :

Code :

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

1
2
3
4
5
6
7
8
Private Declare Function FindWindowA& Lib "user32" _
(ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function GetSystemMenu& Lib "user32" _
(ByVal hWnd&, ByVal bRevert&)
Private Declare Function RemoveMenu& Lib "user32" _
(ByVal hMenu&, ByVal nPosition&, ByVal wFlags&)
Private Declare Function DrawMenuBar& Lib _
"user32" (ByVal hWnd&)

Code dans initialise

Code :

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

1
2
3
4
5
6
7
8
Private Sub UserForm_Initialize()
Dim hWnd&, hSysMenu&
hWnd = FindWindowA(vbNullString, Me.Caption)
hSysMenu = GetSystemMenu(hWnd, 0)
RemoveMenu hSysMenu, &HF060, 0
RemoveMenu hSysMenu, &HF010, 0
DrawMenuBar hWnd
End Sub

et avec ca pas de possibilité de toucher a la barre de titre

Edit : ta fonction est testée et elle me sera sans doute très utile (et bizarrement j'en avais cherché une du type et j'avais fait choux blanc !)
Merci de tes contrib comme d'habitude !!!