Décompte sur Userform se fige

**goninph** · 10/04/2022, 09h48

Bonjour,

J'ai créé un décompte pour faire patienter l'utilisateur

Total = le nombre de lignes non vides de mon tableau

Numéro de la ligne = variable de la boucle qui boucle sur toutes les lignes

Décompte = Total - Numéro de la ligne

Le décompte fonctionne, mais

Mon USERFORM apparait, mais sans le décompte

Pour voir le décompte sur mon USERFORM je dois cliquer avec ma souris sur une autre application ou sur le bureau de mon deuxième écran

Si je clique sur le USERFORM le décompte se fige

Si je clique sur le tableau Excel le décompte se fige

Si je paramètre ShowModal = la macro ne démarre pas

Merci pour aide

Meilleures salutations
Philippe

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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
Option Explicit
'Public Commande As Integer
Sub Gantt()
Dim Trouve As Range
Dim PlageDeRecherche As Range
Dim Holydays As Variant
Dim TrouveHolydays As Range
Dim Valeur_Cherchee As Variant
Dim JourDePose As Variant
Dim ColonneTrouvee As Variant
Dim LigneTrouvee As Long
Dim Date_debut As Variant
Dim Date_Fin As Variant
Dim Ligne_Date_debut As Long
Dim Premiere_commande As Long
Dim Derniere_commande As Long
Dim Commande As Integer
Dim LigneCommande As Long
Dim Derniere_ligne_pleine As Long
Dim Total_commande As Long
Dim Decompte As Long
Dim f As Variant
Application.ScreenUpdating = False
    Sheets("Planning").Select
    Set f = Sheets("Planning")
    Total_commande = Sheets("DATA_RDV_LOOK").Cells(Rows.Count, 1).End(xlUp).Row - 1
    f.Columns("AC:ADC").EntireColumn.Hidden = False
    USF_Synchronisation_Fin.Show
    'Lancer le rafraichissement / srv-sql 3E_BEWEG / Pour_Data_RDV_LOOK / Nom utilisateur : look / Mot de passe : look
    ActiveWorkbook.RefreshAll
    If f.FilterMode = True Then f.ShowAllData 'Enlever les filtres
'    Derniere_ligne_pleine = 1000 'plage de travail pour la boucle, effacer les données, les filtres
    Derniere_ligne_pleine = Range("AA65536").End(xlUp).Row 'plage de travail pour la boucle, effacer les données, les filtres
    If f.Range("AA10") <> "" Then
        'Placement du texte des travaux devant la planification, cellule avant le premier "g"
        Valeur_Cherchee = CDate(f.Range("AA10"))
        'Recherche si la date existe dans le planning
        Set PlageDeRecherche = f.Range(f.Cells(9, 30), Cells(9, Cells(9, Columns.Count).End(xlToLeft).Column))    '58=colonneBF  49=laligne et Cells(49, Columns.Count).End(xlToLeft).Column = dernière colonne de la non vide de la ligne 49 'Important!!! pour les dates ou les nombres = Format de cellule ajuster au texte
        Set Trouve = PlageDeRecherche.Find(what:=Valeur_Cherchee, LookIn:=xlValues, LookAt:=xlWhole)
        If Trouve Is Nothing Then
            'Si pas trouvé
            MsgBox "La date recherchée " & Valeur_Cherchee & " n'éxiste pas dans le planning.", vbExclamation, "! Oups ! Action interrompue"
            Exit Sub
        Else
            'Si trouvé
            'Boucle pour planifier les commandes
            'On efface tout le tableau
            f.Range(Cells(10, 30), Cells(Derniere_ligne_pleine, 783)).ClearContents
            For Commande = 1 To Derniere_ligne_pleine
                LigneCommande = 9 + Commande
 
                'Lors de l'arrivée sur la formule sans date
                If IsDate(f.Cells(LigneCommande, 27)) Then 'Vérifier si la valeur est une date
                    'Vérifier si Date_debut est valide est présente dans le plannig
                    Date_debut = CDate(f.Cells(LigneCommande, 27))
                    Ligne_Date_debut = f.Cells(LigneCommande, 27).Row
                    If Date_debut = 0 Then Exit Sub
                        Valeur_Cherchee = Date_debut
                    'Recherche si la date existe dans le planning
                    Set PlageDeRecherche = f.Range(f.Cells(9, 30), Cells(9, Cells(9, Columns.Count).End(xlToLeft).Column))    '58=colonneBF  49=laligne et Cells(49, Columns.Count).End(xlToLeft).Column = dernière colonne de la non vide de la ligne 49 'Important!!! pour les dates ou les nombres = Format de cellule ajuster au texte
                    Set Trouve = PlageDeRecherche.Find(what:=Valeur_Cherchee, LookIn:=xlValues, LookAt:=xlWhole)
                    If Trouve Is Nothing Then
                        'Si pas trouvé
                        MsgBox "La date de début recherchée " & Valeur_Cherchee & " n'éxiste pas dans le planning.", vbExclamation, "! Oups ! Action interrompue"
                        Exit Sub
                    End If
                    'Vérifier si Date_Fin est valide est présente dans le plannig
                    Date_Fin = CDate(f.Cells(LigneCommande, 28))
                    If Date_Fin = 0 Then Exit Sub
                    Valeur_Cherchee = Date_Fin
                    'Recherche si la date existe dans le planning
                    Set PlageDeRecherche = f.Range(f.Cells(9, 30), Cells(9, Cells(9, Columns.Count).End(xlToLeft).Column))    '58=colonneBF  49=laligne et Cells(49, Columns.Count).End(xlToLeft).Column = dernière colonne de la non vide de la ligne 49 'Important!!! pour les dates ou les nombres = Format de cellule ajuster au texte
                    Set Trouve = PlageDeRecherche.Find(what:=Valeur_Cherchee, LookIn:=xlValues, LookAt:=xlWhole)
                    If Trouve Is Nothing Then
                        'Si pas trouvé
                        MsgBox "La date de fin recherchée " & Valeur_Cherchee & " n'éxiste pas dans le planning.", vbExclamation, "! Oups ! Action interrompue"
                        Exit Sub
                    End If
'                    'Ecrire un texte avant le début de la planification
'                        ColonneTrouvee = Trouve.Column
'                        Cells(Ligne_Date_debut, ColonneTrouvee - 1).Value2 = Cells(Ligne_Date_debut, 22) & " - " & Cells(Ligne_Date_debut, 28)
'                        Cells(Ligne_Date_debut, ColonneTrouvee - 1).Font.Name = "Calibri"
'                        Cells(Ligne_Date_debut, ColonneTrouvee - 1).HorizontalAlignment = xlRight
                    'Boucle pour marquer les jours de pose
                    For JourDePose = Date_debut To Date_Fin 'définir le début et la fin de la boucle
                        'Recherche la date dans le planning
                        Set PlageDeRecherche = f.Range(f.Cells(9, 30), Cells(9, Cells(9, Columns.Count).End(xlToLeft).Column))    '58=colonneBF  49=laligne et Cells(49, Columns.Count).End(xlToLeft).Column = dernière colonne de la non vide de la ligne 49 'Important!!! pour les dates ou les nombres = Format de cellule ajuster au texte
                        Set Trouve = PlageDeRecherche.Find(what:=JourDePose, LookIn:=xlValues, LookAt:=xlWhole)
                        If Trouve Is Nothing Then
                            'Si pas trouvé
                            MsgBox "La date recherchée " & Valeur_Cherchee & " n'éxiste pas dans le planning.", vbExclamation, "! Oups ! Action interrompue"
                    Else
                            'Si trouvé
                            If Weekday(JourDePose, vbMonday) > 5 Then
                                'ne rien faire si c'est un weekend
                            Else
                                'vérifier si c'est un jour férié
                                Set Holydays = Sheets("DATA_Ferie").Range("Jours_Feries_Ponts")
                                Set TrouveHolydays = Holydays.Find(what:=JourDePose, LookIn:=xlValues, LookAt:=xlWhole)
                                If TrouveHolydays Is Nothing Then
                                    'si la date n'est ni un weekend ni un jour férié
                                    ColonneTrouvee = Trouve.Column
                                    Cells(Ligne_Date_debut, ColonneTrouvee).Value2 = "g"
                                    Cells(Ligne_Date_debut, ColonneTrouvee).Font.Name = "Webdings"
                                    Cells(Ligne_Date_debut, ColonneTrouvee).HorizontalAlignment = xlCenter
                                End If 'si jour férié
                            End If 'si weekend
                        End If 'de trouve pour le placement des "g"
                    Next JourDePose 'relance la boucle pour marquer les jours de pose
                    'Ecrire un texte à la fin de la planification
                    Cells(Ligne_Date_debut, ColonneTrouvee + 1).Value2 = Cells(Ligne_Date_debut, 27) & " - " & _
                                                                            Cells(Ligne_Date_debut, 23) & " - " & _
                                                                            Cells(Ligne_Date_debut, 25) & "h/" & _
                                                                            Cells(Ligne_Date_debut, 24) & " pièces - " & _
                                                                            Cells(Ligne_Date_debut, 22) & " - " & _
                                                                            Cells(Ligne_Date_debut, 19) & "." & Cells(Ligne_Date_debut, 20) & " - " & _
                                                                            Cells(Ligne_Date_debut, 18) & " - " & _
                                                                            Cells(Ligne_Date_debut, 21)
                    Cells(Ligne_Date_debut, ColonneTrouvee + 1).Font.Name = "Calibri"
                    Cells(Ligne_Date_debut, ColonneTrouvee + 1).HorizontalAlignment = xlLeft
                Else
                    Exit For 'Si la valeur n'est pas une date on sort
                End If
                Decompte = Total_commande - Commande
                USF_Synchronisation_Fin.Lb_Total_commande.Caption = Decompte
            Next Commande  'relance la boucle pour planifier les commandes
        End If
    Else 'de If LabelDateDebut <> "" Then
        MsgBox "La cellule est vide, impossible de planifier.", vbExclamation, "! Oups ! Action interrompue"
    End If
'    MsgBox "La mise à jour est terminée. " & vbLf & vbLf & Commande - 1 & " commandes importées.", vbInformation, "Info"
'USF_Sablier.Hide
USF_Synchronisation_Fin.Lb_Total_commande.Caption = "La mise à jour est terminée. " & vbLf & Total_commande & " commandes importées" & vbLf & " depuis"
Application.ScreenUpdating = True
End Sub

**Zekraoui_Jakani** · 10/04/2022, 13h57

Vous pouvez vous inspirer de ceci :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
'Créez une Procedure appelée monTiming, cette procedure va mettre à jour l'hologe toutes les secondes.
Sub monTiming()
    Application.OnTime Now + TimeValue("00:00:1"), "Mise_A_Jour"
End Sub
 
'Initier "monTiming" via "Mise_A_Jour", de cette façon les 2 prosédures s'appellent mutuellement
Sub Mise_A_Jour()
    ThisWorkbook.Sheets("sheet12").Range("A1") = Format(Now(), "yyyy mmm d, hh:mm:ss")
    monTiming
End Sub

**goninph** · 10/04/2022, 17h43

Merci, mais ce n'est pas pour un affichage sur un UserForm ?

**Zekraoui_Jakani** · 10/04/2022, 18h58

Mais si; il suffit de lier un textBox à la cellule où se fait le calcul !

**goninph** · 10/04/2022, 19h38

Je dois supprimer l'affichage du UserForm et ajouter ScreenUpdating True et false ce qui me rallonge le temps d'exécution et je n'ai plus le Userform pour afficher le décompte.

Code :

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

1
2
3
4
5
 
 
                Application.ScreenUpdating = True
                f.Range("U3") = Decompte
                Application.ScreenUpdating = False

Mon décompte fonctionne, mais pour le voir je dois cliquer sur une autre application pour rafraichir le UserForm, à s'arracher les cheveux

Sans rien faire rien ne s'affiche
Nom : Blanc.png
Affichages : 112
Taille : 2,5 Ko

Nom : Blanc.png
Affichages : 112
Taille : 2,5 Ko

En cliquant sur une autre application le décompte se déroule
Nom : avec décompte.png
Affichages : 112
Taille : 45,8 Ko

**Zekraoui_Jakani** · 10/04/2022, 19h48

Sauf si vous affichez le résultat directement sur le UserForm
Auquel cas, remplacer cette ligne :

Code :

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

ThisWorkbook.Sheets("sheet12").Range("A1") = Format(Now(), "yyyy mmm d, hh:mm:ss")

Par ceci:

Code :

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

Me.TxtBox1 =  Format(Now(), "yyyy mmm d, hh:mm:ss")  'TextBox1 est à créer bien entendu !

'Autant mettre toutes les procédures dépendantes du formulaire, au lieu de les mettre dans un module standard (à tester)

**goninph** · 10/04/2022, 19h51

Mon décompte est issu du résultat d'une boucle qui modifie les 747 lignes l'une après l'autre, pas d'une valeur de temps.

Voir la variable "Decompte" de mon premier poste

**Zekraoui_Jakani** · 10/04/2022, 19h53

C'est pour ça que j'ai écrit "Vous pouvez vous inspirer de ceci"

**goninph** · 10/04/2022, 20h02

Mon décompte fonctionne, mais pour le voir je dois cliquer sur une autre application pour rafraichir le UserForm, à s'arracher les cheveux

J'ai ajouté les copies d'écran dans le post de 19h38

Je viens de trouver la solution pour :
Après avoir cliqué sur une autre application le décompte se fait, mais si je clique sur Userform le décompte de fige

Code :

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

1
2
3
4
5
USF_Synchronisation_Fin.Enabled = False
 
La macro qui lance le décompte
 
USF_Synchronisation_Fin.Enabled = True

**Zekraoui_Jakani** · 10/04/2022, 22h38

A mon humble avis, il faut repenser le concept; Personnellement, j'utiliserai le décompte sur mon UserForm (dans un textBox), et je n'aurai pas besoin de changer d'application pour avancer ou arrêter le compteur.

**goninph** · 10/04/2022, 22h54

C'est ce que j'ai depuis le début, le décompte est dans un label ou un textbox, même problème.

**Arkham46** · 11/04/2022, 04h32

Bonjour,

Forcez l'affichage du formulaire avec un Repaint, suivi d'un doEvents :

Code :

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

1
2
USF_Synchronisation_Fin.Repaint
DoEvents

Le DoEvents rendant la main à l'utilisateur qui pourrait perturber l'exécution de la macro, ajoutez en début et fin la désactivation/activation de l'interactivité :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Application.Interactive = False
Application.ScreenUpdating = False
USF_Synchronisation_Fin.Show
For ..
  ...
  USF_Synchronisation_Fin.Lb_Total_commande.Caption = Decompte
  USF_Synchronisation_Fin.Repaint
  DoEvents
Next
USF_Synchronisation_Fin.Lb_Total_commande.Caption = "xxxxxx"
USF_Synchronisation_Fin.Repaint
Application.Interactive = True
Application.ScreenUpdating = True

Une petite gestion d'erreurs ne serait pas superflue, pour notamment réactiver tout ce qui a été désactivé en cas d'erreur inatendue.

**goninph** · 11/04/2022, 10h10

Nickel, ça fonctionne enfin, mille mercis.

Par contre, je n'ai ajouté que USF_Synchronisation_Fin.Repaint

Code :

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

1
2
3
4
5
6
7
8
9
10
                Else
                    Exit For 'Si la valeur n'est pas une date on sort
                End If
                Decompte = Total_commande - Commande
 
                USF_Synchronisation_Fin.Repaint 'Pour que le décompte et l'image soient visibles
                                                'et ne se figent pas lors d'un clic sur excel ou userform
                USF_Synchronisation_Fin.Lb_Total_commande.Caption = Decompte
            Next Commande  'relance la boucle pour planifier les commandes
        End If

et j'ai pu supprimer USF_Synchronisation_Fin.Enabled = False et false

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
Private Sub BT_Synchroniser_LOOK_Click()
Dim f As Variant
Dim Total_commande As Long
    Unload Me
'    USF_Synchronisation_Fin.Enabled = False 'Pour éviter de figer le décompte au clic sur USF_Synchronisation_Fin
    ActiveWorkbook.RefreshAll
    Set f = Sheets("Planning")
    f.Range("Cell_MAJ_Donnee_LOOK") = Now
    f.Columns("AC:ADC").EntireColumn.Hidden = True
'    USF_Synchronisation_Fin.Enabled = True 'Pour pouvoir fermer USF_Synchronisation_Fin
    USF_Synchronisation_Fin.Show
    Total_commande = Sheets("DATA_RDV_LOOK").Cells(Rows.Count, 1).End(xlUp).Row - 1
    USF_Synchronisation_Fin.Lb_Total_commande.Caption = "La mise à jour est terminée. " & vbLf & Total_commande & " commandes importées" & vbLf & " depuis"
End Sub
Private Sub BT_Synchroniser_Gantt_Click()
Dim f As Variant
    Unload Me
'    USF_Synchronisation_Fin.Enabled = False 'Pour éviter de figer le décompte au clic sur USF_Synchronisation_Fin
    USF_Synchronisation_Fin.BT_Annuler.Visible = False
    If (MsgBox("Actualiser le diagramme de Gantt ?", vbYesNo + vbQuestion, "Actualiser") = vbYes) Then
        Synchronisation.Gantt
    End If
    USF_Synchronisation_Fin.BT_Annuler.Visible = True
'    USF_Synchronisation_Fin.Enabled = True 'Pour pouvoir fermer USF_Synchronisation_Fin
    Set f = Sheets("Planning")
    f.Range("Cell_MAJ_Donnee_LOOK") = Now
End Sub

Encore merci pour le temps consacré à élucider mon problème

Meilleures salutations
Philippe

Décompte sur Userform se fige

Excel

Discussions similaires

Partager

Partager