Temporiser l'affichage d'une UF

max60

XLDnaute Nouveau
Bonjour ,
Pour finaliser une appli VBA de rangement de fichiers Mails , je cherche à permettre de temporiser l'affichage d'une UF , indiquant clairement l’étape en cours. (Un MsgBox améliorée...)
Je ne parviens pas à faire fonctionner ma UF :
fm_MsgBoxTemp

Elle est appelée depuis une sub :
Sub AffMess_1(Msg, Col, AffTerm)
fm_MsgBoxTemp.Label1.BackColor = Col
fm_MsgBoxTemp.BackColor = Col
fm_MsgBoxTemp.Label1.Caption = Msg
fm_MsgBoxTemp.Show

Dans la UF :
Private Sub UserForm_Activate()
Application.Wait Now + TimeValue("0:00:04")
Unload fm_MsgBoxTemp
End sub

Private Sub UserForm_Terminate()
AffTerm = 1
End Sub

L'affichage de l'UF se produit bien mais bloque (en auto comme en pas a pas) au moment de l'activation , avec message erreur 438 : "Propriété ou méthode non géré par cet objet"

Que faire ?
Cdlt.
max60
 

max60

XLDnaute Nouveau
Bonjour,

Je viens de vérifier et de comprendre que le VBA d'Outlook , n'est pas le même que celui d'Excel ou de Word .... (je travaille dans OL2013 pour le gestion de mes mails...)
Suite à cela , j'ai compris que "Application.Wait Now " ne pouvait fonctionner.

J'ai recherché et trouvé une autre façon de temporiser :

1) Déclarer "Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)"
2) Lancer la tempo par : "Call Sleep(4000)"
Cela fonctionne , mais , nouveau problème : Lors de l'affichage de l'UF , celui-ci est vide... (uniformément blanc)

J'ai donc crée un nouveau module et deux UFs dédiés (avec des Textbox remplis) , pour faire des essais d’enchaînement et d'affichage :
Cela fonctionne en Pas à Pas , mais pas en 'auto' !..

Remplacer "Call sleep" par une boucle d'incrémentation ne change rien !
Les UF en mode auto (seulement) sont toujours vides !
(Ci-joint mes fichiers d'essais)

Quelques idées ?
Que se passe-t-il ??
Cordialement.
max60
 

Pièces jointes

  • Essais-UF.zip
    2.2 KB · Affichages: 4

max60

XLDnaute Nouveau
Bonjour à vous deux ,

Merci patricktoulon , pour votre suggestion appropriée ...
Je viens de 'débloquer' la situation.

Voici les quelques lignes , simplistes mais efficaces , qui permettront de réussir une "cascade" de messages portés par UF.
VB:
Sub EssaiCascadeUF()
        UF_1.Show
        UF_2.Show
End Sub
Puis , dans le code des deux userForms :
Code:
Private Sub UserForm_activate()
        TimeDebut = Timer
        
        DoEvents

        While Timer < TimeDebut + 4
        Wend

        Unload Me
End Sub

Je vais maintenant pouvoir adapter cela à mon projet en cours.

Bon Dimanche à vous 2
Cdlt.
max60
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Observation: (début de rédaction avant le message de patricktoulon)
Mettez le DoEvents dans la boucle While Timer < TimeDebut + 4, sinon c'est pareil: plus rien d'autre ne pourra s'exécuter pendant l'attente.
Le mieux serait quand même d'arriver à planifier la fermeture avec un Application.OnTime. J'ai un module standard de service à usage exclusif d'objets Planification munis d'un évènement Échoit qui permet de faire ça si ça vous intéresse.
 

Dranreb

XLDnaute Barbatruc
Je vous en donne déjà les codes, puisque vous ne semblez pas avoir besoin d'un de vos classeurs joint, adapté par mes soins :
Module standard MPlanification :
VB:
Option Explicit
Private TPlanifications() As Planification, Idt As Long

Rem. En principe vous ne devriez pas avoir besoin de cette procédure, qui désactive tous les objets Planification.
Public Sub DéplanifierTout()
   Dim P As Long, M As Long
   On Error Resume Next: M = UBound(TPlanifications): If Err Then Exit Sub
   On Error GoTo 0
   For P = 1 To M: Idt = Idt Mod M + 1
      If Not TPlanifications(Idt) Is Nothing Then TPlanifications(Idt).Annuler
      Set TPlanifications(Idt) = Nothing: Next P
   End Sub

Rem. Ne pas utiliser ces autres procédures: elles sont à l'usage exclusif des objets Planification.
Public Function IdtPlanificationLancée(ByVal Source As Planification) As Long
   Dim P As Long, M As Long
   On Error Resume Next: M = UBound(TPlanifications): If Err Then ReDim TPlanifications(1 To 1): M = 1
   On Error GoTo 0
   For P = 1 To M: Idt = Idt Mod M + 1: If TPlanifications(Idt) Is Nothing Then Exit For
      Next P: If P > M Then ReDim Preserve TPlanifications(1 To P): Idt = P
   Set TPlanifications(Idt) = Source
   Application.OnTime Source.HeureOT, "'MPlanificateur.OnTimeJoue " & Idt & "'"
   IdtPlanificationLancée = Idt
   End Function
Public Sub AnnulerPlanification(ByVal Idt As Long)
   On Error Resume Next
   Application.OnTime TPlanifications(Idt).HeureOT, "'MPlanificateur.OnTimeJoue " & Idt & "'", Schedule:=False
   Set TPlanifications(Idt) = Nothing
   End Sub
Private Sub OnTimeJoue(ByVal Idt As Long)
   On Error Resume Next
   TPlanifications(Idt).MéthodeRéservéeÀOnTimeJoue
   Set TPlanifications(Idt) = Nothing
   End Sub
Module de classe Planification :
VB:
Rem. Cette classe permet d'exploiter un Application.Ontime dans des objets, via un évènement Échoit.
Option Explicit
Event Échoit() ' Évènement. Se produit à l'échéance du délai.
Private HOT As Date, Idt As Long
Public Sub PlanifierDans(ByVal Délai)
Rem. ——— Méthode. Planifie l'évènement Échoit dans un délai indiquée. Annule une éventuelle planification préalable.
'     Délai: Expression String de la forme "hh:mm:ss" ou bien un nombre de secondes.
   If Engagé Then MPlanificateur.AnnulerPlanification Idt
   If VarType(Délai) = vbString Then HOT = Now + TimeValue(Délai) Else HOT = Now + TimeSerial(0, 0, Délai)
   Idt = MPlanificateur.IdtPlanificationLancée(Me)
   End Sub
Public Sub Annuler()
Rem. ——— Méthode. Annule la dernière planification s'il en existe une.
   If Idt > 0 Then MPlanificateur.AnnulerPlanification Idt: Idt = 0
   End Sub
Public Function HeureOT() As Date
Rem. ——— Propriété en lecture seule. Dernière heure de planification.
   HeureOT = HOT
   End Function
Public Function Engagé() As Boolean
Rem. —— Propriété en lecture seule. Condition planification lancée.
   Engagé = Idt > 0: End Function
'
  
Public Sub MéthodeRéservéeÀOnTimeJoue() ' NE PAS UTILISER.
   Idt = 0: RaiseEvent Échoit
   End Sub
 

max60

XLDnaute Nouveau
Bonjour patricktoulon ,

Merci pour votre nouveau retour.

Concernant l'aide apportée à mon soucis : c'est Ok.

Même si l'idée d'utiliser les UserForm pour afficher des messages peut déranger certains puristes (que nous sommes parfois...) , je trouve au final l'utilisation des UFs adapté a mes attentes.

Encore merci , a tous , pour votre implication.

Cdlt.
max60.