Pause / Démarrer pour une boucle

Salut le forum !

J'ai besoin d'un peu d'aide et je n'ai pas trouver précisément ce que je cherche dans les sujets similaires

Je souhaite que les utilisateurs du fichier, puissent mettre en pause la boucle de la macro

Application.OnTime Now + TimeValue("00:00:10"), "XX"

Je pense à un simple bouton "Pause" auquel serait affecter votre code

Est-ce que je suis sur la bonne voie ? ou faut-il coder directement sur ma macro "XX"

Je pense également à un bouton "Démarrer" pour relancer, mais pour le coup j'espère pouvoir me débrouiller en affectant à un bouton "XX"

Qu'en pensez vous ?

N'hésitez pas à me demander un bout de fichier/code si jamais vous en avez besoin

Merci d'avance

Bonjour,

alors je n'hésite pas ! Pouvez vous donnez un "bout de fichier" avec votre code fonctionnel pour le lancement d'Application.OnTime.

Merci.

@ bientôt

LouReeD

Bonjour LouReeD,

Allons-y c'est partit

Je m'excuse par avance pour le code, j'apprends seul et le plus souvent sans support...

XX Macro
'
     Windows("Source palettier.xlsx").Activate
    Range("A1").Select
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Windows("Plan palettier.xlsx").Activate
    Sheets("Brut SQL").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("A transfert").Select
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range("B2:L247").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("A").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Application.Run "NOTE"

    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Z").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("A").Select

    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("A transfert").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select

    Sheets("Brut SQL").Select
    Range("A1").Select

    Application.OnTime Now + TimeValue("00:00:10"), "XX"
'
End Sub

Je suppose que le code est celui de la SUB XX ?

Et "Note" ne fait rien d'autre d'important ?

@ bientôt

LouReeD

Yes absolument

A priori il faut deux fichiers... les avez-vous en format anonymisé ?

Si oui n'hésitez pas, Ou bien je crée de mon côté une boucle avec la mise en place de la pause et il vous faudra adapter.

@ bientôt

LouReeD

Je vais choisir la facilité

Bonjour,

Je me permet de donner une opinion, mais au vu du code, si le problème initial est de pauser la macro car temps d'exécution trop long, je pense qu'on peut éviter l'ajout d'un bouton simplement en optimisant la macro. Vos opérations de copier/coller pourraient etre quasi instantanées en réalité.

A voir donc, si ce n'est pas le problème, ne pas prendre en compte mon message.

Petit code qui permet de lancer un Application.OnTime, puis de le mettre en pause, en fait cela l'arrête :

Public Chrono

Sub ToutesLes05Secondes()
    ActiveSheet.Range("A1").Interior.Color = Int(Rnd * 1000000)
    Chrono = Now + TimeValue("00:00:05")
    Application.OnTime Chrono, "ToutesLes05Secondes"
End Sub

Sub LancerPause()
    If ActiveSheet.Shapes(Application.Caller).TextFrame2.TextRange.Characters.Text = "Lancer" Then
        ToutesLes05Secondes
        ActiveSheet.Shapes(Application.Caller).TextFrame2.TextRange.Characters.Text = "Pause"
    Else
        Application.OnTime Chrono, "ToutesLes05Secondes", schedule:=False
        ActiveSheet.Shapes(Application.Caller).TextFrame2.TextRange.Characters.Text = "Lancer"
    End If
End Sub

Le fichier :

On met en mémoire le lancement d'Application.OnTime grâce à la variable Chrono, ce qui nous permet de la stopper facilement en faisant référence à Chrono.

Maintenant voyons voir votre retour suite à la remarque pertinente de saboh12617 !

En effet votre code contient énormément de Select = Code d'enregistreur de macro ?

@ bientôt

LouReeD

Merci pour vos réponses

Malgré mes codes peu académiques, le temps d'exécution est très court. Il n'est pas en cause

Merci pour le code

Je reviens vers vous rapidement pour vous dire si c'est ok pour moi

Bon j'aurais au moins le mérite d'avoir essayer tout seul

Est-ce que vous pouvez me détailler les étapes pour adapter et placer le code svp ?

Merci

Bonjour,

Vos fichiers ne comportent pas de code...

@ bientôt

LouReeD

Désolé

Est-ce que c'est mieux comme ça ?

Le code proposé intégré à votre fichier.

Mise en place du bouton Lancer / Pause sur la feuille "Brut"
Ajout d'un code à la "sortie" du fichier afin d'arrêter le Application.OnTime, sinon le fichier se réouvre pour son exécution me semble-t-il :

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next: Application.OnTime Chrono, "XX", schedule:=False
End Sub

avec une gestion d'erreur dans le cas où le code n'aurait pas été lancé.

Je n'ai pas testé, voici le fichier :

@ bientôt

LouReeD

Bonjour,

Merci pour cette essai

Si j'ai bien suivi vos consignes, ce qui n'est pas certain, l'exécution bloque à

Apllication.OnTime Chrono, "XX", schedule:=False

Il me réclame un objet

J'aimerais m'assurer que le code à la "sortie" du fichier n'est pas en cause pour cette erreur.

Je ne l'ai pas encore rentrer

Et est-ce que que vous pouvez me confirmer que le bouton "Lancer/Pause" doit bien être ajouté et affecter avant le lancement de XX avec "Lancer" pour texte

Je remets une version de mon fichier

Merci

Bonjour,

Le bouton doit être affecté à la procédure LancerPause, et il faut mettre Chrono en déclaration Public, et ce Chrono doit être = non + le délai voulu.

@ bientôt

LouReeD

Je pense avoir rempli ces 3 dernières conditions correctement

J'ai toujours le même message d'erreur au même niveau

bonsoir,

Apllication.OnTime Chrono, "XX" est différent de Application.OnTime Chrono, "XX"

Désolé je ne l'avez pas vu celle là sur votre précédent message.

En corrigeant tout devrait rentrer dans l'ordre.

Avez vous "tapez" le texte à la main ? Si oui, ne mettez plus les majuscule, lors de la validation de la ligne si VBA reconnait une instruction, il la passera en majuscule minuscule tout seul, c'est un moyen simple de vérifier les fautes de frappes.

@ bientôt

LouReeD

Bonjour LouReeD,

Il n'est que 7h et la journée est déjà bien partit

A priori, ça tourne !

Merci pour ta patience

Peut-être une dernière question :

Si je mets le bouton sur pause avant de fermer le fichier, est-ce nécessaire d'ajouter le code en sortie de fichier ?

Merci encore en tout cas

Bonsoir,

si vous mettez sur pause bien évidemment que le code de sortie ne sert pas, mais si vous oubliez alors vous êtes sur que le Application.OnTime ne se mette pas en marche.

Par contre il faut ajouter la ligne de changement de nom du bouton :

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next: Application.OnTime Chrono, "XX", schedule:=False
    ActiveSheet.Shapes(Application.Caller).TextFrame2.TextRange.Characters.Text = "Lancer"
End Sub

@ bientôt

LouReeD