Probleme de Loop...

[pavilion]

Bonjour,
Quelqu'un aurait la solution à mon problème:
J'ai un Loop à l'infini qui ne s'arrete pas
Comment stopper?
Merci


Sub MiseEnGrasDesSamediEtDimanche()
Range("A4").Select
Do Until ActiveCell = ""
If Weekday(CDate(ActiveCell.Value)) = 1 Or Weekday(CDate(ActiveCell.Value)) = 7 Then
Selection.Font.Bold = True
.Interior.ColorIndex = 15
Else
Selection.Font.Bold = False
End If

ActiveCell.Offset(1, 0).Activate
Loop

 

[MJ13]

Re : Probleme de Loop...

Bonjour Pavillon

A tester:

Sub MiseEnGrasDesSamediEtDimanche()
Range("A4").Select
Stop
Do Until ActiveCell = ""
If Weekday(CDate(ActiveCell.Value)) = 1 Or Weekday(CDate(ActiveCell.Value)) = 7 Then
With Selection.Font.Bold = True
ActiveCell.Interior.ColorIndex = 15
End With
Else: Selection.Font.Bold = False
End If
ActiveCell.Offset(1, 0).Activate
Loop
End Sub

 

[ROGER2327]

Re : Probleme de Loop...

Bonjour pavilion

En l'état, cette procédure ne peut fonctionner (et surtout pas boucler indéfiniment).

Procédure modifiée :

[COLOR="DarkSlateGray"][B]Sub MiseEnGrasDesSamediEtDimanche()
  Range("A4").Select
  Do Until ActiveCell = ""
    If Weekday(CDate(ActiveCell.Value)) = 1 Or Weekday(CDate(ActiveCell.Value)) = 7 Then
      Selection.Font.Bold = True
      [COLOR="Red"]Selection[/COLOR].Interior.ColorIndex = 15
    Else
      Selection.Font.Bold = False
    End If
    ActiveCell.Offset(1, 0).Activate
  Loop
[COLOR="Red"]End Sub[/COLOR][/B][/COLOR]

(Testé)​

ROGER2327
#4424

Vendredi 27 Haha 138 (Occultation d' Alfred Jarry, SPs)
11 Brumaire An CCXIX
2010-W44-1T16:16:46Z

 

[MJ13]

Re : Probleme de Loop...

Re

Autant pour moi, pas bien compris

Sinon:

Sub MiseEnGrasDesSamediEtDimanche()
Range("A4").Select
'Stop
Do Until ActiveCell = ""
If Weekday(CDate(ActiveCell.Value)) = 1 Or Weekday(CDate(ActiveCell.Value)) = 7 Then ActiveCell.Font.Bold = True: ActiveCell.Interior.ColorIndex = 15: ActiveCell.Font.Bold = True Else ActiveCell.Font.Bold = False
ActiveCell.Offset(1, 0).Activate
Loop
End Sub

ou

Sub MiseEnGrasDesSamediEtDimanche2()
For Each Cell In Range("A4:A" & [A65536].End(xlUp).Row)
If Weekday(CDate(Cell.Value)) = 1 Or Weekday(CDate(Cell.Value)) = 7 Then Cell.Font.Bold = True: Cell.Interior.ColorIndex = 15: Cell.Font.Bold = True Else Cell.Font.Bold = False
Next
End Sub

 

[pavilion]

Re : Probleme de Loop...

Bonjour et merci de vos réponses

J'ai essayé les deux formule et toujours pareil sa défile indéfiniment

=A4153+1 ect, ect...
Alors que normalement il devrait s'arreter à 368 jours

quand j'appui sur echap cela stoppe avec une fenetre qui s'ouvre
Fin Continuer ou Débogage

en débogage End If est pointé sur fond jaune

Que peut on faire ?
et Merci encore

 

[MJ13]

Re : Probleme de Loop...

Re

Euh, un petit fichier ?

 

[ROGER2327]

Re : Probleme de Loop...

Re...

(...)
Euh, un petit fichier ?

Cela serait en effet bien utile. J'ai vraiment testé la procédure sans rencontrer de problème. L'environnement de la procédure doit y être pour quelque chose...​

ROGER2327
#4427

Vendredi 27 Haha 138 (Occultation d' Alfred Jarry, SPs)
11 Brumaire An CCXIX
2010-W44-1T18:08:17Z

 

[pavilion]

Re : Probleme de Loop...

Mon fichier fait 3,86 Mone passe pas.

Cette application permet de gérer ue réservation d'objet selon des dates de prèt
Le nombre d'objet va de 1 à 15.
Ces objets peuvent ètre par exemple un parc de véhicules, un ensemble de salle de réunions etc...
A chaque objet est associé un bouton qui permet de consulter l'objet.

Aurait'il une solution ?

Merci

 

[pavilion]

Re : Probleme de Loop...

Bonsoir Jean-Marcel

Oui effectivement l'application est télécharger depuis l'espace Download
l'auteur n'a pas signé.
Effectivement il y a une feuille "Cadre" masquée

L'application est interressante a la condition que dans la feuille Cadre
Lors du changement d'année, j'incrire la date du premier de l'an dans la cellule A2 ( feuille cadre) et ensuite Outils/Macro/Macro/miseEnGrasSamediEtDimanche et exécuter.

La cà défile et certainement jusqu'a 65556 lignes

comment faire et qui est l'auteur ?
Cordialement

 

[ROGER2327]

Re : Probleme de Loop...

Re...

(...)
La cà défile et certainement jusqu'a 65556 lignes
(...)

Message #1 :

(...)
J'ai un Loop à l'infini qui ne s'arrete pas
(...)

Il faudrait savoir !
Sur ma machine vétuste, le code s'exécute en 44 secondes sur la plage A4:A65535. Même si ce code n'est pas très bon, rien à voir avec un "loop à l'infini" !
En ajoutant

[COLOR="DarkSlateGray"][B]With Application: .Calculation = xlCalculationManual: .EnableEvents = False: .ScreenUpdating = False: End With[/B][/COLOR]

au début de la procédure et

[COLOR="DarkSlateGray"][B]With Application: .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlCalculationManual: End With[/B][/COLOR]

à la fin, la durée d'exécution tombe à moins de 20 secondes.
Ras le bol des problèmes qui n'en sont pas...​

ROGER2327
#4427

Vendredi 27 Haha 138 (, )
11 Brumaire An CCXIX
2010-W44-1T20:28:20Z