XL 2019 Rotation automatique entre 2 feuilles

pierrelcq

XLDnaute Junior
Bonjour,

J'essai de mettre en place une macro qui permet de faire la rotation entre deux feuilles excel toutes les 30 secondes.

1/ Je souhaiterai que cette macro ne soit prise en compte que lorsque nous sommes [jeudi/vendredi/samedi/dimanche]

2/ Je souhaiterai qu'elle puisse se désactiver facilement en cliquant sur n'importe quelle feuille du classeur pour arrêter la rotation.


Voici pour le moment l'ébauche de la macro, mais elle ne fonctionne apparemment pas ...

Sub Rotation()
Dim I As Long
While ActiveSheet.Name = "TDB S" Or ActiveSheet.Name = "TDB S+1"
For I = 1 To 30
Application.Wait Now + TimeValue("0:00:01")
DoEvents
If Weekday(Now, vbMonday) >= 4 Then
'Rien
Else
If ActiveSheet.Name = "TDB S" Then
Feuil25.Activate
ElseIf ActiveSheet.Name = "TDB S+1" Then
Feuil22.Activate
End If
End If
Next
Wend
End Sub

En ésperant que vous allez pouvoir m'aider.

Pierre
 

Pièces jointes

  • Copie de excel pour aide.xlsm
    313.3 KB · Affichages: 13
Solution
Bonjour,

1/ Je souhaiterai que cette macro ne soit prise en compte que lorsque nous sommes [jeudi/vendredi/samedi/dimanche]

Nous sommes Lundi, pas de rotation .... ;)

Sinon pour forcer mettre les lignes suivantes en commentaire dans Module1/Rotation
Sub Rotation()

If IsRotation Then
' If Weekday(Now, vbMonday) >= 4 Then
IsRotation = True <-- inutile
Sheets(IIf(ActiveSheet.Name = "TDB S", "TDB S+1", "TDB S")).Activate
Application.OnTime Now + TimeValue("00:00:15"), "Rotation"
DoEvents ' pour le timer Sav
' Else
' IsRotation = False
' End If
End If

End Sub

fanch55

XLDnaute Barbatruc
Bonjour,

1/ Je souhaiterai que cette macro ne soit prise en compte que lorsque nous sommes [jeudi/vendredi/samedi/dimanche]

Nous sommes Lundi, pas de rotation .... ;)

Sinon pour forcer mettre les lignes suivantes en commentaire dans Module1/Rotation
Sub Rotation()

If IsRotation Then
' If Weekday(Now, vbMonday) >= 4 Then
IsRotation = True <-- inutile
Sheets(IIf(ActiveSheet.Name = "TDB S", "TDB S+1", "TDB S")).Activate
Application.OnTime Now + TimeValue("00:00:15"), "Rotation"
DoEvents ' pour le timer Sav
' Else
' IsRotation = False
' End If
End If

End Sub
 
Dernière édition:

pierrelcq

XLDnaute Junior
Salut merci pour ton aide, j'ai réussi de mon côté à faire qlq chose qui me convient parce que j'arrivais pas à construire autour de ta macro.

Sub Rotation()
Dim I As Long
While ActiveSheet.Name = "TDB S" Or ActiveSheet.Name = "TDB S+1"
For I = 1 To 30
Application.Wait Now + TimeValue("0:00:01")
DoEvents
Next
If Weekday(Now, vbMonday) <= 3 Then
'Rien
Else
If ActiveSheet.Name = "TDB S" Then
Feuil25.Activate
ElseIf ActiveSheet.Name = "TDB S+1" Then Feuil22.Activate
End If
End If
Wend
End Sub
 

fanch55

XLDnaute Barbatruc
2/ Je souhaiterai qu'elle puisse se désactiver facilement en cliquant sur n'importe quelle feuille du classeur pour arrêter la rotation.

Un application.wait fige tout ce qui est excel sur le poste (pas que le classeur en cours )
==> curseur type sablier, ce qui veut dire qu'Excel est "occupé/stressé" .​

A la lecture de votre code, vous allez attendre 30 fois 1 seconde,
A chaque itération, la pile des exécutions Excel en attente sera exécutée (Doevents),
ce qui revient à dire que le delta final avant l'affichage de l'autre feuille sera entre 30 secondes et 30+n secondes ( selon le contenu de la pile ) .
Le seul moyen d'arrêter votre boucle sera de cliquer sur un onglet autre que les 2 feuilles considérées, ce qui ne sera fait au mieux qu'au bout des 30 secondes .

L'avantage de mon code (que j'ai simplifié) est de ne rien bloquer
et d'être immédiatement désactivable.
VB:
Private Sub Workbook_Open()
  ' Existant : une sauvegarde à faire dans 5 minutes
    Intervalle = Now + TimeValue("00:05:00")
    Application.OnTime Intervalle, "Sauv"
    
  ' On lance la rotation
  ' Si le jour est jeudi/vendredi/samedi/dimanche
    If Weekday(Now, vbMonday) >= 4 Then Rotation
    
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  
   ' On supprime la tache horaire de Rotation
    If RotationId > 0 Then
        Application.OnTime RotationId, "Rotation", , False
        Application.StatusBar = ""
        RotationId = Empty
    End If
    
End Sub
VB:
' Identification du Timer : important pour le désactiver
Public RotationId As Date

Sub Rotation()

    ' Liste des feuilles à afficher
      Dim Fls() As Variant
      Fls = Array("TDB S+1", "TDB S")
        
    ' On active la feuille qui n'est pas actuellement affichée (flip/flop)
      Sheets(IIf(ActiveSheet.Name = Fls(0), Fls(1), Fls(0))).Activate
      
    ' Création d'une tache horaire à faire dans 30 secondes
      RotationId = Now + TimeValue("00:00:30") ' 30 secondes
      Application.OnTime RotationId, "Rotation"
    
    ' On indique que la rotation est en cours
      Application.StatusBar = "Prochaine rotation à " & Format(RotationId, "hh:mm:ss")

End Sub
 

Pièces jointes

  • PierreLq.xlsm
    306 KB · Affichages: 7

eriiic

XLDnaute Barbatruc
Bonjour à tous,
Fanch, une suppression à la fermeture aussi non ?
Pour éviter une réouverture du fichier.
Dans ThisWorkbook :
VB:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If RotationId > 0 Then
        Application.OnTime RotationId, "Rotation", , False
        Application.StatusBar = ""
        RotationId = Empty
    End If
End Sub
eric
 

fanch55

XLDnaute Barbatruc
Fanch, une suppression à la fermeture aussi non ?
Salut @eriiiic ,
Les Ontime sont supprimés automatiquement à la fermeture de l'application Excel et non pas du classeur.
Tu as tout à fait raison, il faut prévoir la suppression à la fermeture du classeur, et même être plus rigoureux en créant le Ontime en rajoutant ThisWorkbook aux Sheets... ;)

VB:
Private Sub Workbook_Open()
  ' Existant : une sauvegarde à faire dans 5 minutes
    Intervalle = Now + TimeValue("00:05:00")
    Application.OnTime Intervalle, "Sauv"
    
  ' On lance la rotation
  ' Si le jour est jeudi/vendredi/samedi/dimanche
    If Weekday(Now, vbMonday) >= 4 Then Rotation
    
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
   ' On supprime la tache horaire de Rotation
    Stop_Rotation
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
   ' On supprime la tache horaire de Rotation
    Stop_Rotation
End Sub
Code:
' Identification du Timer : important pour le désactiver
Public RotationId As Date

Sub Rotation()

    ' Liste des feuilles à afficher
      Dim Fls() As Variant
      Fls = Array("TDB S+1", "TDB S")
        
    ' On active la feuille qui n'est pas actuellement affichée (flip/flop)
      ThisWorkbook.Sheets(IIf(ActiveSheet.Name = Fls(0), Fls(1), Fls(0))).Activate
      
    ' Création d'une tache horaire à faire dans 30 secondes
      RotationId = Now + TimeValue("00:00:30") ' 30 secondes
      Application.OnTime RotationId, "Rotation"
    
    ' On indique que la rotation est en cours
      Application.StatusBar = "Prochaine rotation à " & Format(RotationId, "hh:mm:ss")

End Sub

Sub Stop_Rotation()
   ' On supprime la tache horaire de Rotation
    If RotationId > 0 Then
        Application.OnTime RotationId, "Rotation", , False
        Application.StatusBar = ""
        RotationId = Empty
    End If
End Sub
 

pierrelcq

XLDnaute Junior
Bonjour à vous deux,

Merci pour votre aide, pour le coup, j'ai repris entièrement votre code, il marche parfaitement, juste une question concernant :
Application.StatusBar = ""

C'est quoi le status bar?

Par ailleurs quand vous dites que votre code est immédiatement désactivable, c'est à dire qu'il suffit de cliquer par exemple sur n'importe quelle case et il s'arrête ?

Merci beaucoup

Pierre
 
Dernière édition:

fanch55

XLDnaute Barbatruc
C'est quoi le status bar?
C'est la barre en bas d'excel ( non affichée en fullscreen ) .
on peut y mettre des infos discrètes :
1603994550324.png

Par ailleurs quand vous dites que votre code est immédiatement désactivable, c'est à dire qu'il suffit de cliquer par exemple sur n'importe quelle case et il s'arrête ?
Dans la mesure où il ne bloque rien : il fait une action et se programme pour être relancé 30 secondes plus tard via un Ontime .
Si vous cliquez n'importe où sur une feuille Excel, l'événement Workbook_SheetSelectionChange est appelé et annule le Ontime .
 

pierrelcq

XLDnaute Junior
Bonjour,

Une dernière chose, vous lancez la rotation à l'ouverture de l'excel ?

Private Sub Workbook_Open()
' On lance la rotation
' Si le jour est jeudi/vendredi/samedi/dimanche
If Weekday(Now, vbMonday) >= 4 Then Rotation

Je veux qu'elle s'active uniquement quand j’appuie sur le bouton.


Merci pour l'explication de la status bar, elle est peu utile dans ce cas, car nous utilisons le plein écran.

Merci pour votre aide

Pierre
 

fanch55

XLDnaute Barbatruc
Classeur modifié ci-joint .
Plus de lancement automatique à l'ouverture du fichier .
La rotation peut être lancée :
avec les touches "Control + r"​
1604407066994.png
via une forme, une image, un bouton de formulaire​
1604407288304.png
via un Activex​
1604407760842.png
 

Pièces jointes

  • PierreLq.xlsm
    308.7 KB · Affichages: 7

Discussions similaires

Statistiques des forums

Discussions
311 711
Messages
2 081 789
Membres
101 817
dernier inscrit
carvajal