XL 2019 Rotation automatique entre 2 feuilles

P

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
fanch55
Bonjour,

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

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
Cliquez pour agrandir...
Trier par date Trier par votes
fanch55

fanch55

XLDnaute Barbatruc
Bonjour,

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

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
Cliquez pour agrandir...
 
Dernière édition:
Vote positif 0 Vote négatif
Solution
P

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
 
Vote positif 0 Vote négatif
fanch55

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.
Cliquez pour agrandir...

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
Vote positif 0 Vote négatif
eriiic

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
 
Vote positif 0 Vote négatif
fanch55

fanch55

XLDnaute Barbatruc
eriiiic à dit:
Fanch, une suppression à la fermeture aussi non ?
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
P

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:
Vote positif 0 Vote négatif
fanch55

fanch55

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

pierrelcq à dit:
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 ?
Cliquez pour agrandir...
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 .
 
Vote positif 0 Vote négatif
P

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
 
Vote positif 0 Vote négatif
fanch55

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
Vote positif 0 Vote négatif

Discussions similaires

D
  • Question
XL 2019 Message diffèrent en fonction état booléens
Réponses
3
Affichages
506
darkjedi
D
C
  • Résolu(e)
XL 2019 Importer fichier csv sans consatener les colonnes
2 3
Réponses
34
Affichages
2 K
laurent950
laurent950
cathodique
  • Résolu(e)
XL 2010 Problème màj feuilles depuis fichiers CSV
2
Réponses
23
Affichages
2 K
cathodique
cathodique
Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
880
Nicolas JACQUIN
Nicolas JACQUIN
patricktoulon
  • Question
Autres que penses vous de ce mini test benchmark(timer plus precis)
Réponses
6
Affichages
428
patricktoulon
patricktoulon
P
  • Question
XL 2019 Rotation automatique entre deux feuilles
Réponses
11
Affichages
1 K
Phil69970
Phil69970
P
  • Question
XL 2016 ROTATION FEUILLE AUTOMATIQUE
Réponses
4
Affichages
798
pierrelcq
P
I
  • Résolu(e)
Microsoft 365 [RESOLU] Boucler sur une partie de code
Réponses
5
Affichages
564
Icedarts
I
P
  • Question
XL 2019 Correction macro rotation feuille
Réponses
6
Affichages
1 K
pierrelcq
P
H
  • Question
Autres mise a jour automatique feuille excel vba
Réponses
2
Affichages
489
HANN
H

Membres actuellement en ligne

21 membres et 202 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 626
Messages
2 111 291
Membres
111 092
dernier inscrit
ThomasU3