[Résolu] Defilement des feuilles d'un classeur en taches de fond

[Adam0308]

Bonjour à tous,

Je viens vers vous afin que savoir comment faire pour lancer une macro qui fait défiler les Feuilles Visibles une à une mais pouvant être arrêter à tout moment.

Je ne suis pas développeur, et j'utilise Excel comme un outil, beaucoup de choses ne doivent pas cadrer avec les bonnes pratiques courantes.

Aujourd'hui, la macro faisant défiler les feuilles visibles je l'ai faite, toutes les x secondes ca passe à la feuille suivante et arrivé à la dernière Feuille ca reprend la 1ere Feuille. Pour faire ceci j'ai fait une jolie boucle While avec une condition à la "1=1".

Dans la macro, il y a déjà un truc pour connaitre le dernier état de la macro "ROTATION" ou "STOP"

Je voulais savoir comment faire pour que un bouton puisse arrêter ma macro.

Voici mon code.

​

    Sub RotationFeuille()


    Sheets("DATA - Liste Feuille Visible").Columns("A").ClearContents


    ' On liste les feuilles visibles
    Dim lRow As Long

      With Sheets("DATA - Liste Feuille Visible")
      .Cells(1).CurrentRegion.ClearContents
      lRow = 1
      For Each Sh In ActiveWorkbook.Sheets
      If Sh.Visible Then
      .Cells(lRow, 1).Value = Sh.Name
      lRow = lRow + 1
      End If
      Next Sh
      End With

    ' On définie un "crawler"
    Dim pointerligne As Integer
    pointerligne = 1

    ' Selon l'état de la rotation, soit on la lance soit on l'arrete
    ' Si la rotation est en cours et qu'on veut l'arreter
    If Sheets("DATA - Liste Feuille Visible").Cells(1, 5) = "ROTATION" Then

      Sheets("DATA - Liste Feuille Visible").Cells(1, 5) = "STOP"
      'MsgBox ("STOP")

    Else
    ' Si on veut relancer la rotation, on va activer 1 à 1 les feuilles visibles avec une tempo de

      Sheets("DATA - Liste Feuille Visible").Cells(1, 5) = "ROTATION"

      Do While 1 = 1

      Do While pointerligne <> lRow


      x = Sheets("DATA - Liste Feuille Visible").Cells(pointerligne, 1)
      Sheets(x).Activate
      'Sheets(x).Select
      'Sheets(x).Calculate
      'Sheets(x).Cells(1, 1).Select
      Sheets(x).Range("AA500").Activate
      Sheets(x).Range("A1").Activate
      ActiveWindow.ScrollRow = 1
      ActiveWindow.ScrollRow = 1
      ActiveWindow.ScrollColumn = 1
      'ActiveWindow.SmallScroll Down:=-1
      'ActiveWindow.SmallScroll Down:=1
      'MsgBox (x)
      'Worksheets(trackerlRow).Activate
      pointerligne = pointerligne + 1
      Application.Wait (Now + TimeValue("0:00:05"))


      Loop

      pointerligne = 1

      Loop

    End If


    End Sub

 

[eriiic]

Bonjour,

je n'ai pas regardé ton code non mis avec la balise code et donc imbuvable.
Pour traiter un événement insère un DoEvents dans ta boucle.
eric

 

[Victor21]

Bonjour, Adam0308, bienvenue sur XLD, bonjour, eric

@eriiiic : sympa l'accueil ! Canicule ?

 

[job75]

Bonjour Adam0308, eriiiic, Patrick,

Fichier joint avec cette macro :

Dim marche As Boolean 'mémorise la variable

Sub Rotation()
'se lance par Ctrl+R
Dim tempo#, i%, t#
tempo = 1 'temporisation 1 seconde
marche = Not marche 'inversion
Do
    If Not marche Then End 'arrêt
    i = ActiveSheet.Index
1   For i = i + 1 To Sheets.Count
        If Sheets(i).Visible = xlSheetVisible Then Exit For
    Next
    If i > Sheets.Count Then i = 0: GoTo 1
    Sheets(i).Activate
    t = Timer + tempo
    While Timer < t: DoEvents: Wend
Loop
End Sub

Pas de bouton mais un raccourci clavier pour lancer ou arrêter le processus.

A+

 

[Adam0308]

Merci pour vos retours rapides.
Je viens d'editer avec la balise code et je vais test ton code Job75.

Keep in touch

 

[eriiic]

@eriiiic : sympa l'accueil ! Canicule ?

Bah, je vais droit au but...
Désolé si ça a froissé qq'un
eric

 

[Adam0308]

Re,

Pas de soucis Eric
Et un grand merci Job75, ca fonctionne niquel.

Pas de bug d'affichage comme j'ai pu avoir de mon côté d'où les balades d'une celulle à l'autre avec en prime des scroll de partout
C'est là où on voit la différence entre ceux qui connaissent vraiment le VB et ceux qui bidouille comme moi ^^

Je vais creuser un peu ces histoires de DoEvents ^^