Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 Timer VBA - fermeture automatique d'un UserForm

Thibault2612

XLDnaute Junior
Bonjour à tous,

J'utilise une macro faisait apparaître un UserForm après l'appuie sur un bouton.

J'aimerais savoir si il est possible que mon UserForm se ferme tout seul au bout de 5/10 minutes si il n'y a pas d'activé dans mon UserForm. C'est à dire que je n'ai toucher à aucun bouton dans mon UserForm ?

Je vous remercie d'avance.

cordialement, Thibault
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
La variable a contenant l'heure ne devrait pas être une variable locale sinon on ne peut plus la retrouver dans une autre procédure pour l'annuler à cette heure là avec Schedule:=False

Personnellement j'aime bien isoler les bouts de programme un peu compliqués dans des modules que je ne vais plus aller regarder ensuite.
La partie compliquée :
Dans un module standard nommé MPlanificateur :
VB:
Option Explicit
Private Planifications As New Collection
Public Function IdtPlanif(ByVal Source As Planification) As String
IdtPlanif = Rnd * &H1000000
Application.OnTime Source.HeureOT, "'OnTimeJoue """ & IdtPlanif & """'"
Planifications.Add Source, IdtPlanif
End Function
Public Sub StopperPlanif(ByVal IdtPlanif As String)
Dim Planif As Planification
On Error Resume Next: Set Planif = Planifications(IdtPlanif): If Err Then Exit Sub
On Error GoTo 0
Application.OnTime Planif.HeureOT, "'OnTimeJoue """ & IdtPlanif & """'", Schedule:=False
Planifications.Remove IdtPlanif
End Sub
Public Sub OnTimeJoue(ByVal IdtPlanif As String)
Dim Planif As Planification
On Error Resume Next: Set Planif = Planifications(IdtPlanif): If Err Then Exit Sub
On Error GoTo 0
Planifications.Remove IdtPlanif
Planif.OnTimeJoueÉchoit
End Sub
Public Sub DéplanifierTout()
Do While Planifications.Count > 0: Planifications(1).Déplanifier: Loop
End Sub
Dans un module de classe nommé Planification :
VB:
Option Explicit
Event Échoit() ' Le délai d'échéance à été atteint.
Private HOT As Date, Idt As String

Public Sub PlanifierDans(ByVal Délai)
Rem. ——— Méthode. Planifie l'évènement Échoit pour une durée indiquée.
'Paramètre Délai: Expression String de la forme "hh:mm:ss"
'                 ou bien un nombre de secondes.
'        Remarque: Une éventuelle planification préalable est annulée.
If Idt <> "" Then MPlanificateur.StopperPlanif Idt
If VarType(Délai) = vbString Then
      Délai = TimeValue(Délai)
Else: Délai = TimeSerial(0, 0, Délai): End If
HOT = Now + Délai
Idt = MPlanificateur.IdtPlanif(Me)
End Sub

Public Sub Déplanifier()
Rem. ——— Méthode. Annule la dernière planification.
If Idt = "" Then Exit Sub
MPlanificateur.StopperPlanif Idt
Idt = ""
End Sub

Public Function HeureOT() As Date
Rem. ——— Propriété en lecture seule. Dernière heure de planification.
HeureOT = HOT
End Function

Public Sub OnTimeJoueÉchoit()
Rem. ——— Méthode à usage du module MPlanificateur uniquement.
Idt = "": RaiseEvent Échoit
End Sub
La partie simple, dans l'Userform :
Code:
Option Explicit
Private WithEvents Fermer As Planification
Private Sub UserForm_Initialize()
Set Fermer = New Planification
…
…
…
Fermer.PlanifierDans "0:5"
…
…
…
Private Sub Fermer_Échoit()
Unload Me
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode > vbFormControlMenu Then Exit Sub
Fermer.Déplanifier
End Sub
 
Dernière édition:

Si...

XLDnaute Barbatruc
Bonjour

Et en plaçant tous les Contrôles dans un Cadre de la taille du Formulaire comme ici ?

Dans un module standard
VB:
Public Cmp As Byte
Sub Bouton1_Clic()
  Cmp = 15: Tempo: UsF.Show
End Sub

Sub Tempo()
  UsF.Frame1.Caption = "Fermeture dans : " & Cmp & " seconde" & IIf(Cmp > 1, "s", "")
  If Cmp > 0 Then
      Cmp = Cmp - 1
  Else
      Unload UsF
  End If
  Application.OnTime Now + TimeValue("00:00:01"), "Tempo", 0
End Sub


et dans la page de code du formulaire

VB:
Private Sub Frame1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  Cmp = 15
End Sub

Private Sub UserForm_Terminate()
  End
End Sub
 

Pièces jointes

  • Usf en tempo.xlsm
    21.5 KB · Affichages: 123

Discussions similaires

T
  • Résolu(e)
Microsoft 365 pb effacement macro
Réponses
8
Affichages
427
Themax
T
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…