Temporisation qui bloc juste la macro dans une feuille
bo njour je voudrez savoir comment on fait pour faire une temporisation juste sur la macro d'une feuille sans bloqué les aure execution dans le module .... merci.
Bonjour,
Un peu plus d'explications pour qu'on comprenne de quoi il retourne exactement et ce que tu veux qu'il se passe, ne serait pas superflu.
Cordialement.
merci de ta réponse, et bien en faite , j'ai une colonne qui ce remplie au fur et a mesure , et dans ma macro sur la feuille 1, je parcoure cette colonne et je compare a chaque fois la valeur "ligne,colonne" et "ligne+1 , colonne" , l'une des condition que je dois tout le temps vérifie c'est la case "ligne,col", "ligne+1,col" ne soient pas vide, et si c'est le cas il faut attendre quel ce remplisse, sauf que j'ai tout essaie pour que ma macro attendent que le tableau ce remplisse mais elle bug tout le temps !
j'ai essai la boucle while
une tempo avec un timer
un goto
mais tout bug on dirais que tout ce que je emt dans cette foutu boucle for la fait bugué, il faut savoir que mon tableau ce rempli avec des données d'un capteur et donc il y'a des fonction deriére dans un module pour faire la communication du capteur et de excel.
en gros j'arrive pas a faire attendre ma boucle que le tableau ce remplisse
Dim DerniereLigne As Long
Dim bouclage As Long
Dim top As Integer
Dim ligne As Long, col As Long
Dim resultat As String
Dim date_reel As String
Dim heure As String
Dim heure_2 As String
Dim temps_perdu As Date
Dim diff As Date
Dim index As String
Dim mesure As String
Dim le_chiffre As Long
heure = "00:00:00 "
heure_2 = "00:00:00 "
diff = "00:00:00 "
DerniereLigne = Range("A11").SpecialCells(xlCellTypeLastCell).Row
'-------------------------------------- parcour du tableau acquisition ------------------------------------------------------------
'bien on a maintenant le nombre de lignes renseignée dans le sheet
'maintenant on va boucler sur toute les lignes et a chaque ligne boucler sur toute les colonne de la ligne qui sont renseignée
If init_ligne > 11 Then ' on initialise la ligne de la boucle for soit a la ligne 11 si la valeur de la variable init_ligne n'est pas
Else ' superieur a la valeur 11, sinon on ne modifie pas la variable si la valeur de init_ligne est superieur a 11
init_ligne = 11 ' puisque c'est valeur qui est superieur a 11 est affecté a la variable correspond a la ligne sur la quel le message
End If ' d'alerte du retard de production et donc comme ça la boucle repartira apartir de la dernier ligne ou on il y'a eu arret
' cela permet de regler le bug du userform qui s'affiche sans arret aprés la premiére apparition
For ligne = init_ligne To DerniereLigne
For col = 1 To 4
'------------------ verification de la presence de valeur dans la cellule avant tout ----------------------
If Cells(ligne, col) <> "" And Cells(ligne + 1, col) <> "" Then
'-------------------------------------- Traitement cellule DATE ------------------------------------------------------------
If col = 1 Then
date_reel = Cells(ligne, col)
'-------------------------------------- Traitement cellule HEURE ------------------------------------------------------------
ElseIf col = 2 Then
heure = Cells(ligne, col)
heure_2 = Cells(ligne + 1, col)
'-------------------------------------- Traitement cellule INDEX ------------------------------------------------------------
ElseIf col = 3 Then
index = Cells(ligne, col)
'-------------------------------------- Traitement cellule capteur ------------------------------------------------------------
ElseIf col = 4 Then
mesure = Cells(ligne, col)
'-------------------------------------- processus de traitement ------------------------------------------------------------
If mesure <> Cells(ligne + 1, col) Then 'on compare la valeur du capteurau moment n et n+1 si ils sont different
temps_perdu = CDate("00:00:00 ")
ElseIf mesure = Cells(ligne + 1, col) Then 'on compare la valeur du capteur au moment n et n+1 si ils sont egaux
diff = CDate(heure_2) - CDate(heure)
temps_perdu = CDate(temps_perdu) + CDate(diff)
If temps_perdu >= "00:00:30" Then ' on verifie si le retard cumulé a depassé 40seconde
'MsgBox temps_perdu
Unload avertissement
avertissement.temps = temps_perdu
avertissement.date_arret = date_reel
avertissement.heure_arret = heure - temps_perdu
avertissement.Show 0
'ActiveSheet.Copy After:=ActiveSheet
'If avertissement.Visible = False Then
'temps_perdu = "00:00:00"
' Else
' End If
init_ligne = ligne
End If
End If
'------------------------------------- FIN TRAITEMENT CELLULE---------------------------------------------
End If 'colonne 4
Else 'si la cel+1 est vide
Exit For
End If
' Call sauvgarde
Next col
Next ligne
End Subje c'est c'est pas facile de comprendre un code pareil
REMARQUE : la macro ne bug pas si je n'essai pas de faire une temporisation, mais cela fonctionne pas bien
Non ! Je ne vais pas lire ton code : pas indenté ! bourré de commentaires (ça ne m'apprend rien et ça me perturbe), et plein de lignes vides (ça fait scroller...)
Mais si quand une cellule est vide, il faut attendre qu'elle se remplisse (tu n'as pas dit comment...), il te faut introduire une boucle Do... Loop : Do While cellule = "" et dans la boucle une instruction DoEvents pour que la mise à jour puisse intervenir.
La boucle doit tester ligne+1 avant ta comparaison ligne/ligne+1, pour que la comparaison puisse avoir lieu ainsi que l'opération que tu prévois...
Cordialement.
Salut mferrand ! Merci pour ta réponse ! Alors déjà mon code est bien indenté regarde bien avant de faire des conclusions
Alors déjà mon code est bien indenté regarde bien avant de faire des conclusions
Permets-moi de ne pas être du tout de ton avis !
Je suis très certainement hyper-maniaque en la matière, mais je considère que l'indentation doit répondre à des règles strictes et systématiques, et je doute fort que tu puisses me détailler exhaustivement les règles que tu appliques en la matière, vu le résultat !
Cordialement.
C'est subjectif comme avis ! Est de mon avis c'est assez claire pour moi et propre ! Dabs tout les cas restons concentré sur le vrai problème ! Je vous dit a lundi chet amis !! Bon week end
Bonjour Mferrand ,
voila j'ai essai l'astuce dont tu m'a parler j'ai ajout une boucle do while pour verifier et attendre avec doevents a l'interieure, mais la macro devient super lente bien qu'au début au moins ca bugé pas et mon tableau ce rempli lentement tout les 28 seconde alors que ca devrait être toute les 1 seconde ! je te met mon code pour voir ! j'ai vraiment l'impression que le fait de mettre une boucle while ou un goto ... fait systématiquement bugé ma macro bien que "doevents a unpeu contourné le probléme mais pas vraiment beaucoup !
Private Sub Worksheet_Change(ByVal Target As Range)
Dim DerniereLigne As Long
Dim bouclage As Long
Dim top As Integer
Dim ligne As Long, col As Long
Dim resultat As String
Dim date_reel As String
Dim heure As String
Dim heure_2 As String
Dim temps_perdu As Date
Dim diff As Date
Dim index As String
Dim mesure As String
Dim le_chiffre As Long
heure = "00:00:00 "
heure_2 = "00:00:00 "
diff = "00:00:00 "
' initialisation de la dernier ligne de la col A sachant que A11 est la premiere cellule a remplire
DerniereLigne = Range("A11").SpecialCells(xlCellTypeLastCell).Row
'---------------------------------------------------------------------------------------------------------------------------------
'-------------------------------------- parcour du tableau acquisition ------------------------------------------------------------
'----------------------------------------------------------------------------------------------------------------------------------
'bien on a maintenant le nombre de lignes renseignée dans le sheet maintenant on va boucler sur toute les lignes et a chaque ligne boucler sur toute les colonne de la ligne qui sont renseignée
' on initialise la ligne de la boucle for soit a la ligne 11 si la valeur de la variable init_ligne n'est pas superieur a la valeur 11, sinon on ne modifie pas la variable si la valeur de init_ligne est superieur a 11 puisque c'est valeur qui est superieur a 11 est affecté a la variable correspond a la ligne sur la quel le message d'alerte du retard de production et donc comme ça la boucle repartira a partir de la dernier ligne ou on il y'a eu arret cela permet de regler le bug du userform qui s'affiche sans arret aprés la premiére apparition.
If init_ligne > 11 Then
Else
init_ligne = 11
End If
For ligne = init_ligne To DerniereLigne
For col = 1 To 4
Do While Cells(ligne, col) = "" And Cells(ligne + 1, col) = ""
If Cells(ligne, col) = "" And Cells(ligne + 1, col) = "" Then
Exit Do
Else
DoEvents
End If
Loop
'---- verification de la presence de valeur dans la cellule avant tout -------------
If Cells(ligne, col) <> "" And Cells(ligne + 1, col) <> "" Then
'-------------------- Traitement cellule DATE ----------
If col = 1 Then
date_reel = Cells(ligne, col)
'---------------------- Traitement cellule HEURE ---------
ElseIf col = 2 Then
heure = Cells(ligne, col)
heure_2 = Cells(ligne + 1, col)
'-------------------- Traitement cellule INDEX ---------
ElseIf col = 3 Then
index = Cells(ligne, col)
'------------------ Traitement cellule capteur -----------
ElseIf col = 4 Then
mesure = Cells(ligne, col)
'-------------- processus de traitement -------------
'on compare la valeur du capteurau moment n et n+1 si ils sont different
If mesure <> Cells(ligne + 1, col) Then
temps_perdu = CDate("00:00:00 ")
'on compare la valeur du capteur au moment n et n+1 si ils sont égaux
ElseIf mesure = Cells(ligne + 1, col) Then
diff = CDate(heure_2) - CDate(heure)
temps_perdu = CDate(temps_perdu) + CDate(diff)
' on verifie si le retard cumulé a depassé 30seconde
If temps_perdu >= "00:00:30" Then
Unload avertissement ' pour recharger par la suite le userform
avertissement.temps = temps_perdu
avertissement.date_arret = date_reel
avertissement.heure_arret = heure - temps_perdu
avertissement.Show 0
'ActiveSheet.Copy After:=ActiveSheet
'If avertissement.Visible = False Then
'temps_perdu = "00:00:00"
' Else
' End If
init_ligne = ligne
End If
End If
End If 'colonne 4
End If
Next col
Next ligne
End Suben gros j'ai jouter ça au début de la boucle for :
Do While Cells(ligne, col) = "" And Cells(ligne + 1, col) = ""
If Cells(ligne, col) = "" And Cells(ligne + 1, col) = "" Then
Exit Do
Else
DoEvents
End If
Loop