Affichage usf et fermeture

[Marc_du_78]

Bonjour le Forum,

Par cette belle journée ensoleillée, je viens poser cette question :

Comment faire apparaitre un usf au départ d'un calcul et qui se fermerait une fois le calcul terminé (Nom USF : Patient) dans ce code concu par Bebere, que je remercie de nouveau au passage, en lieu et place du message d'attente :

Sub CompteCoul() 'Details des absences par couleur et 1/2 journee
Dim Commande As Integer
Dim Texte1 As String, Texte2 As String, Texte3 As String
Patient
'déclare les variables x, y, z,v et l
Dim x As Byte, y As Byte, z As Byte, v As Byte, va As Byte, vm As Byte, derl As Byte
derl = Range('C65536').End(xlUp).Row

Application.EnableEvents = False

'Message d'attente
Texte1 = 'Attention, Excel va calculer pour vous.'
Texte2 = 'Ne faites rien même si cela vous paraît un peu long !'
Texte3 = 'Cliquer sur OK pour commencer le décompte.'
Commande = MsgBox(Texte1 & Chr(13) & Texte2 & Chr(13) & Texte3, 0, '')

For x = 11 To derl 'boucle de ligne && jusque derl)
For y = 66 To 125 Step 2 '35 To 63 'boucle sur les 29 couleurs (Tableau de références de F4 à BL4)
v = 0: vm = 0: va = 0 'définit la variable v
For z = 4 To 65 'boucle sur les 31 cellules (de la colonne D à la colonne BM)
'condition: si la cellule à la même couleur de motif que celle mentionné
'dans le tableau de référence, alors redéfinit la variable v : v = v+1

If Cells(x, z).Interior.ColorIndex = CInt(Right(Cells(10, y), Len(Cells(10, y).Value) - 1)) Then v = v + 1
If Cells(9, z) = 'M' Then 'Pour Matinée
vm = vm + v
v = 0
End If

If Cells(9, z) = 'A' Then 'Pour Après midi
va = va + v
v = 0
End If

Next z 'prochaine cellule

'affiche le nombre dans le tableau de références
If vm <> 0 Then Cells(x, y).Value = vm
If va <> 0 Then Cells(x, y).Offset(0, 1).Value = va

Next y 'prochaine couleur de référence

Next x 'prochaine ligne
Application.StatusBar = 'Patientez, le système fait les calculs...'
Application.StatusBar = False
Application.EnableEvents = True
Call SelectionCellul
End Sub

En vous remerciant, jamais suffisamment, de votre aide incomparable.

 

[Creepy]

Bonjour le forum, Marc

Hello voisin, je suis moi même du 78.

Bref voici ce qu'il faut que tu mettes. Il faut passer ta userform en modal.

Qu'est-ce que le modal ? comme j'ai la flemme de taper j'ai fiat un copier/coller de l'aide VBA :

Lorsqu'un objet UserForm n'est pas modal, le code suivant est exécuté dès qu'il apparait. Les feuilles non modales n'apparaissent pas dans la barre des tâches et ne figurent pas dans l'ordre de l'onglet de la fenêtre.

Note Vous risquez de perdre les données associées à un objet UserForm non modal si vous apportez une modification au projet UserForm à l'origine de la recompilation, par exemple, lorsque vous supprimez un module de code.

Un objet UserForm est toujours modal, il en résulte que l'utilisateur doit toujours répondre avant d'utiliser une autre partie de l'application. Aucun autre code ne s'exécutera tant que l'objet UserForm ne sera pas masqué ou déchargé. Bien que les autres feuilles de l'application soient désactivées pendant l'affichage d'un objet UserForm, les autres applications ne le sont pas.

Concretement tu vas mettre ca dans ton code :
...
Dim Texte1 As String, Texte2 As String, Texte3 As String
Patient.show vbModeless (Par defaut tu mets pas Vbmodeless pour stopper le code)
...

et à la fin de ton code :
Call SelectionCellul
UNLOAD PATIENT
End Sub

Et voila

@+

Creepy

 

[Temjeh]

Bonjour à tous
Bonjour Marc
Bonjour Creepy

Aussi moi j'utilise souvent:

Patient.Show 0
DoEvents
Application.ScreenUpdating = False

To code ici

Application.ScreenUpdating = True
Unload Patient

A+

Temjeh

 

[Marc_du_78]

Bonjour le Forum, Creepy, Temjeh

Je vous remercie beaucoup de vos réponses mais voici ce que j'ai fait et ce qui se passe. Mon USF ne s'affiche pas.
l'Usf que j'ai fait
USF Name = Patient
Caption = Calcul en cours
Texte de ma TexBox :
Merci de patienter pendant que EXCEL effectue les calculs !

à : Patient.Show O ca affiche un message : variable non définie

Sub CompteCoul() 'Details des absences par couleur et 1/2 journee
Dim Commande As Integer
Dim Texte1 As String, Texte2 As String, Texte3 As String

Dim x As Byte, y As Byte, z As Byte, v As Byte, va As Byte, vm As Byte, derl As Byte
derl = Range('C65536').End(xlUp).Row
Dim Calcul

Application.EnableEvents = False
Application.ScreenUpdating = False
Patient.Show O
DoEvents

For x = 11 To derl
For y = 66 To 125 Step 2
v = 0: vm = 0: va = 0
For z = 4 To 65


If Cells(x, z).Interior.ColorIndex = CInt(Right(Cells(10, y), Len(Cells(10, y).Value) - 1)) Then v = v + 1
If Cells(9, z) = 'M' Then
vm = vm + v
v = 0
End If

If Cells(9, z) = 'A' Then
va = va + v
v = 0
End If

Next z

If vm <> 0 Then Cells(x, y).Value = vm
If va <> 0 Then Cells(x, y).Offset(0, 1).Value = va

Next y

Next x

Application.EnableEvents = True
Call SelectionCellul
Application.ScreenUpdating = True
Unload Patient
End Sub

En comptant vraiment sur votre aide pour résoudre ce problème, je vous remercie et vous souhaite un bon après midi.

 

[Excel_lent]

Bonjour Marc,
Bonjour tout le monde,

Je n'ai pas encore trouvé la réponse. Je pense qu'on l'aura sous peu.

Pour surmonter cette difficulté, j'ai pensé intégrer un compteur (un défilement dans une cellule attire l'attention) en prévenant l'utilisateur (Texte3).

Texte3 = 'Cliquer sur OK et [u]attendre l'arrêt du compteur ![/u]'
...
   Next y
 'pour un compteur
 [color=#FF0000]Cells(2, 64).Value = x[/color] 'cellule à choisir et à formater convenablement
 
  Next x
 [color=#FF0000]Cells(2, 64).Value = '' [/color]'effacement cellule
 Application.StatusBar = False
 Application.EnableEvents = True

Tu trouveras aussi en tapant 'progressbar', dans la recherche, des barres de défilement. Par exemple ici Lien supprimé

J'étudie encore ton programme pour ma formation. Je te ferai part de mes trouvailles si cela te convient.
cordialement et @+

 

[Hervé]

bonjour tout le monde

Marc,, j'ai rien vu de choquant dans ton code, rien qui n'interdit l'affichage de l'userform.

pourrais tu nous joindre ton fichier.

par contre, supprime les lignes enableevents, inutile voir dangereuse dans ton code.

salut

 

[Bebere]

bonjour Marc,Hervé,Excel_lent,Temjeh,Creepy
essayer ce qui suit et ok

Sub CompteCoul()
Dim x As Byte, y As Byte, z As Byte, v As Byte, va As Byte, vm As Byte, derl As Byte 'déclare les variables x, y, z,v et l
UserForm1.Show
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
derl = Range('C65536').End(xlUp).Row
For x = 11 To 12 'derl 'boucle de ligne && jusque derl)
For y = 66 To 125 Step 2 '35 To 63 'boucle sur les 29 couleurs (Tableau de références de AI9 à BN9)
v = 0: vm = 0: va = 0 'définit la variable v
For z = 4 To 65 'boucle sur les 31 cellules (de la colonne D à la colonne AH)
'condition: si la cellule à la même couleur de motif que celle mentionné
'dans le tableau de référence, alors redéfinit la variable v : v = v+1

If Cells(x, z).Interior.ColorIndex = CInt(Right(Cells(10, y), Len(Cells(10, y).Value) - 1)) Then v = v + 1
If Cells(9, z) = 'M' Then
vm = vm + v
v = 0
End If
If Cells(9, z) = 'A' Then
va = va + v
v = 0
End If
Next z 'prochaine cellule

'affiche le nombre dans le tableau de références
If vm <> 0 Then Cells(x, y).Value = vm
If va <> 0 Then Cells(x, y).Offset(0, 1).Value = va

Next y 'prochaine couleur de référence

Next x 'prochaine ligne
Unload UserForm1
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
pas beaucoup le temps,prochainement j'espère te mettre une version plus rapide(en gros la routine boucle sur du vide)
soit attentif à ce fil
à bientôt à tous

 

[Marc_du_78]

Bonsoir le Forum, Hervé, Excel_lent, Temjeh, Creepy,

Voici le fichier joint. Comme je n'y connais rien en Vba, j'essaie, c'est pourquoi je compte sur vous. [file name=AbsencesCouleurs.zip size=46798]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/AbsencesCouleurs.zip[/file]

 

[Excel_lent]

Bonsoir Marc, Bonsoir à tous,

Que de fois n'ai je répété : 'Quand on l'ouvre, il faut savoir la fermer !'
Je parlais à l'époque des parenthèses. J'aurais dû me l'appliquer pour les balises de mon précédent post !

Dans ton projet, les codes des couleurs étant dispersés, il semble plus simple pour le calcul des cumuls, de partir de ceux-ci au lieu de partir des cellules saisies.

Tu me diras ce que tu en penses.
Je n'ai pas regardé le reste. mais j'ai suivi les recommandations d'Hervé (et d'autres spécialistes) en passant par une petite boolean.

cordialement,
@+

[file name=couleursabsences.zip size=48232]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/couleursabsences.zip[/file]

 

[Marc_du_78]

Bonjour le Forum, Excel_lent,

Je te remercie de pa proposition, mais je bloque sur cette ligne de code qui se met en jaune

If Cells(x, z).Interior.ColorIndex = CInt(Right(Cells(10, y), Len(Cells(10, y).Value) - 1)) Then v = v + 1

Ne sachant que faire, je compte sur toi en te souhaitant un bon après midi.

Ps je ne reçois plus de notification des suivis est-ce normal actuellement ? Y a-t-il un problème ?

 

[Excel_lent]

Bonjour Marc,
Bonjour à tous,

Je vais me pencher sur le problème de cette ligne jaune.

Pour l'instant voici une nouveauté concernant le message d'attente (Creepy te parlait d'une USF en modal).

@+

[file name=Attente_20051123164206.zip size=43728]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Attente_20051123164206.zip[/file]

 

[Bebere]

bonjour à tous
Marc,chose promise, chose due
Excel_lent,dans la ligne qui bug
If Cells(x, z).Interior.ColorIndex =Cells(10, y).Value Then v = v + 1
à bientôt
[file name=GestionDesAbsencesRet.zip size=42112]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/GestionDesAbsencesRet.zip[/file]

 

[Marc_du_78]

Bonjour, le Forum,

Etant parti en mission à Limoges, je n'ai pu revenir plu tôt vers vous et là, c'est Noël avant l'heure.
Aussi je viens très rapidement vous féliciter pour l'aide remarquable (que dis-je : Aide... ?)
Si cette petite application est arrivée à son terme, c'est entièrement grâce à vous;

Reste en suspens, pour moi, que faut-il modifier si le tableau passe à 100 ou 200 noms ?

Reste que je vous adresse tous mes remerciements les plus chaleureux, et tout particulièrement à
(dans le désordre, pardonnez-moi) :

myDearFriend!, - Hellboy, - Bebere, - Jam, - Charly2, - ya_v_ka, - Gérard DEZAMIS,
Creepy, - Temjeh, - Excel_lent, - Hervé, - sans oublier le concepteur d'origine de ce tableau, dont,
malheureusement, je connais pas son identité.

C'est grâce à chacun de vous et à ce Forum que cette réalisation, dont je ne revendique rien, a pu se faire, je n'ai fait
qu'arranger ce tableau par rapport à la demande de mon grand chef sioux. Le travail principal vous en revient et je me
garderai bien d'en prendre quoi que ce soit. C'est pourquoi cette application revient de pelin droit à ce forum et,
s'il agrée ceux qui en ont la charge et la responsabilité jugent utile d'en faire profiter la communauté Exceldienne, alors
n'hésitez pas c'est à vous tous et toutes.

En vous remerciant encore pour le temps que vous m'avez consacré ainsi que de votre grande patience et,
souhaitant longue vie à ce Forum.
A coup sur : A bientôt.

 

[Marc_du_78]

Coucou le Forum,

Quelqu'un peut-il me donner une indication ?

En vous souhaitant un bon après-midi.

PS, je ne reçois plus de notification. Y aurait-il un prob ?

 

[Bebere]

bonsoir Marc
apparemment il y a 2 fils,sur l'autre (celui avec Charly,lequel n'apparait pas quand je clique sur le lien de ton dernier message 28/11 13:43) tu as le final
tu peux ajouter des données
ravi de t'avoir rendu service
à bientôt