Marc_du_78
XLDnaute Accro
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.
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.
