ferma macro

[nicola_na78]

ciao ragazzi, ho ancora bisogno del vostro formidabile aiuto.....
devo fermare una macro quando premo un pulsante ma non mi funziona

faccio cosi:
Private Sub CommandButton1_Click()
Call macro
Exit Sub
End Sub


mi dite come posso fare??? vi ringrazio anticipatamente come al solito.... a presto

[Anthony47]

Ma quale macro vuoi fermare quando premi il pulsante?

Ciao

[nicola_na78]

cioè????

[nicola_na78]

ciao anthony,

premendo un pulsante dovrei stoppare una macro che è in esecuzione....

[Anthony47]

In testa al Modulo vba in cui e' contenuta la macro che vuoi poter stoppare inserisci

Codice: Seleziona tutto

Public StopNow As Boolean


In testa alla macro metti

Codice: Seleziona tutto

StopNow=False


Aggiungi poi all' interno della macro anche questa coppia di istruzioni

Codice: Seleziona tutto

DoEvents
If StopNow then Exit Sub


Il codice invece del Pulsante "Stop" sara' invece

Codice: Seleziona tutto

Private Sub CommandButton1_Click()
StopNow=True
End Sub


Ciao

[nicola_na78]

ho eseguito alla lettera le tue istruzioni ma non funziona..... premo sul pulsante ma nn succede niente..... ciao

[Anthony47]

Devi debuggare il funzionamento della tua macro; ad esempio metti un break sull' istruzione If StopNow then Exit Sub e vedi se ci passi mai e quale e' il valore di StopNow.

Ciao

[nicola_na78]

stopnow da sempre falso....
un'altro metodo????


grazie ciao

[Anthony47]

un'altro metodo????

Si, devi continuare il debug..
Metti il break su StopNow=True e controlla che l' istruzione venga eseguita correttamente e StopNow venga settato; continua il debug in step-by-step usando F8 e accertati che la macro che vuoi stoppare non reimposti StopNow=False e che quando arrivi all' istruzione If StopNow then Exit Sub StopNow sia sempre Vero.

E se non trovi l' inghippo allora pubblica per intero il codice della macro che vuoi stoppare, con la modifica inserita, descrivendo anche che cosa fa, come parte e come secondo progetto dovrebbe fermarsi.

Ciao

[nicola_na78]

ciao scusa se ti risp in ritardo...... ho fatto come dici tu ma non succede nulla..... ti posto la macro cosi' vedi se riesci a darmi una mano.

con un pulsante non dovrei fare altro che quando lo premo ferma la macro sotto....... grazie ciao

Codice: Seleziona tutto

Sub cambia_colore()
On Error Resume Next

    Static lamp As Boolean
    Dim var_t As Date
    DELTAt = "00:00:01"
    CELLA = "A1"
    FOGLIO = "Riordino"

   
    For I = 3 To 100
    If Cells(I, 5) <> "" And Cells(I, 10).Value >= 0 Then
 
        Select Case lamp
            Case True
                Sheets(FOGLIO).Cells(I, 5).Interior.Color = RGB(255, 215, 0) 
                Sheets(FOGLIO).Cells(I, 1).Interior.Color = RGB(255, 215, 0)
                Sheets(FOGLIO).Cells(I, 6).Interior.Color = RGB(255, 215, 0)
            Case Else
                Sheets(FOGLIO).Cells(I, 5).Interior.Color = RGB(186, 85, 211)     
                Sheets(FOGLIO).Cells(I, 1).Interior.Color = RGB(186, 85, 211)
                Sheets(FOGLIO).Cells(I, 6).Interior.Color = RGB(186, 85, 211)
        End Select
       
    Else
        Cells(I, 5).Interior.ColorIndex = xlNone    'Nessun colore
        Cells(I, 6).Interior.ColorIndex = xlNone
        Cells(I, 1).Interior.ColorIndex = xlNone
       
    End If
    Next
    FLASH = Not (lamp)
    Application.OnTime Now + TimeValue(var_t), "cambia_colore"
  On Error GoTo 0

Eliminato Post duplicato e inserito nel Tag idoneo, il codice macro - Flash ore 13:07

[Anthony47]

Questa e' una macro rischedulata col metodo "OnTime", quindi non e' una macro "in esecuzione" ma che "viene messa periodicamente in esecuzione".
Non vedo pero' dove hai provato a mettere le istruzioni che facevano parte della mia ipotetica soluzione; come pure spero che le istruzioni da On Errot GoTo 0 in avanti non siano significative.

ho fatto come dici tu ma non succede nulla.....

Se hai messo il break dove ti ho detto e (dopo aver premuto il pulsante, VERO?) non succede niente significa che la macro di evento CommandButton1_Click non parte: o e' associata male al bottone (molto probabile) o non funziona il tuo vba (molto meno probabile)

Comunque, visto che cosa vuoi fare, non hai bisogno di inserire DoEvents / If StopNow then Exit Sub; basta che modifichi
Application.OnTime Now + TimeValue(var_t), "cambia_colore" in

Codice: Seleziona tutto

If Not StopNow then Application.OnTime Now + TimeValue(var_t), "cambia_colore"


Ma questo ha come presupposto che riesci col pulsante a manipolare StopNow. Se non ci riesci potresti ripiegare su una cella che se messa a 1 impedisce la ripianificazione dell macro; es se usi M1:

Codice: Seleziona tutto

If lamp=true Or Thisworkbook.Sheets("NomeFoglio").Range("M1")=0 then
Application.OnTime Now + TimeValue(var_t), "cambia_colore"
Else Thisworkbook.Sheets("NomeFoglio").Range("M1")=0
End If


In questo modo la macro si ferma lasciando nelle celle il colore violaceo invece che Arancione; usa lamp=False se vuoi fermarti sull' arancione, oppure togli lamp=true Or se ti basta fermarti in qualsiasi colorazione.

Ciao

[nicola_na78]

ciao antony, mi da un mess con errore di runtime........
ma qualcosa tipo exit sub non esiste???? grazie x la tua pazienza..... ciao

[Anthony47]

Hai pubblicato una macro incompleta, e te l' ho detto con discrezione: "spero che le istruzioni da On Errot GoTo 0 in avanti non siano significative".
Quindi devi lavorare sulla macro completa che hai gia' e che gira senza errori, e fare su quella le modifiche (o quella di StopNow e relativo pulsante o quella della cella pilota).

Ciao

[wallace&gromit]

riapro questo topic perché ho il problema che tu Anthony segnalavi a nicola, cioè ho una macro rischedulata che vorrei interrompere (sto rifacendo quel programma di musica dell'anno scorso di cui forse ti ricordi, perché lo voglio adattare ad un emdoor surf pad con schermo touch).

Ho provato ad inserire le istruzioni che hai consigliato sul stopnow. In testa al modulo c'è la prima istruzione public, che qui sotto non vedrai, perché in mezzo ci sono una fila di altre macro che non inserisco qui.
Riporto invece la macro che fa partire la musica su uno dei due lettori e al termine del brano passa automaticamente al successivo (spero che se ne capisca qualcosa, è piuttosto arzigogolata), posso anche inviare il file, ma non funzionerebbe bene senza musica e tutto assieme fa più di 2 giga!:

Codice: Seleziona tutto

Sub Pausa()
StopNow = False
        Application.ScreenUpdating = False
    ActiveSheet.Shapes.Range(Array("RettPausa")).Select
    Selection.ShapeRange.ZOrder msoSendToBack
    abbassato1 = 0
    abbassato2 = 0
    Worksheets("menu").Range("P4") = 1
   
riprendi:
    If Worksheets("menu").Range("P4") = 0 Then 'impedisce di continuare il ciclo se stop lo ha impostato su 0
    Exit Sub
    End If
   
DoEvents
If StopNow Then Exit Sub
   
lettore = Worksheets("menu").Range("P3")    'legge quale lettore deve partire
If lettore = 1 Then
Set myLett = Foglio1.audio1
Set myLettS = Foglio1.audio2
Else: Set myLett = Foglio1.audio2
Set myLettS = Foglio1.audio1
End If

    QuantiBrani = Worksheets("playlistPausa").Cells(Rows.Count, "C").End(xlUp).Row - 1
    Brano = Worksheets("menu").Range("P2") + 1
    Titolo = Worksheets("playlistPausa").Cells(Brano, 3)
    vol = Worksheets("playlistPausa").Cells(Brano, 8)
Iniz = Worksheets("playlistPausa").Cells(Brano, 4)
fine = Worksheets("playlistPausa").Cells(Brano, 7)
    Perc = ThisWorkbook.Path & "\" & Worksheets("playlistPausa").Cells(Brano, 2) & "\"   'percorso del file"
    FileN = Perc & Titolo  'nome del file
   
    myLett.URL = FileN
    myLett.settings.volume = vol
    myLett.Controls.currentPosition = Iniz
    myLett.Controls.Play
   
         Application.ScreenUpdating = True
    ActiveSheet.Shapes.Range(Array("RettPausaEsec")).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Titolo '
   
    Range("K1").Select

    OraInizio = Timer
    i = 0.5                                 'abbassa il volume del lettore inattivo
        Do While i > -0.1
    OraAttuale = Timer
            Do While Timer < OraAttuale + 5
            DoEvents
            Loop
        myLettS.settings.volume = abbassato1 * i
        i = i - 0.1
        Loop
    myLettS.Controls.stop            'ferma del tutto il lettore inattivo
        Do While Timer < OraInizio + 60    'se questo brano è passato per almeno 1 min predispone per nuovo brano se interrotto riprenderà con lo stesso brano
            If Worksheets("menu").Range("P4") = 0 Then 'impedisce di continuare il ciclo se stop lo ha impostato su 0
            Exit Sub
            End If
        DoEvents
        Loop
    nuovoBrano = (Brano - 1) Mod QuantiBrani + 1    'ricomincia da 1 dopo 60
    Worksheets("menu").Range("P3") = Abs(lettore - 3)        'prepara l'altro lettore e memorizza volume attuale
    ActiveWorkbook.Save
    Worksheets("menu").Range("P2") = nuovoBrano
         Application.ScreenUpdating = True
       TempoFine = fine - 20 - Iniz
        Do While Timer < OraInizio + TempoFine
        DoEvents
        Loop
    i = 0.9                                 'sfuma da volume pieno a metà
        Do While i > 0.6
        OraAttuale = Timer
            Do While Timer < OraAttuale + 1
            DoEvents
            Loop
        myLett.settings.volume = vol * i
        i = i - 0.1
        Loop
    abbassato1 = myLett.settings.volume
    GoTo riprendi

End Sub

e questa è la macro che dovrebbe interrompere tutto, invece esegue tutto quello che deve, ma se entro nell'editor delle macro vedo che c'è qualcosa ancora attivo e devo premere il quadrato "ripristina" per riprendere il controllo.

Codice: Seleziona tutto

Sub ChiudiPausa()
    StopNow = True
    Application.ScreenUpdating = True
    ActiveSheet.Shapes.Range(Array("RettPausaEsec")).Select
    Selection.ShapeRange.ZOrder msoSendToBack

volumeAtt1 = Foglio1.audio1.settings.volume
volumeAtt2 = Foglio1.audio2.settings.volume
Worksheets("menu").Range("P4") = 0              'impedisce che il ciclo riprodPausa riprenda

i = 0.9
Do While i > -0.1
    OraAttuale = Timer
    Do While Timer < OraAttuale + 0.3
    DoEvents
    Loop
Foglio1.audio1.settings.volume = volumeAtt1 * i
Foglio1.audio2.settings.volume = volumeAtt2 * i
i = i - 0.1
Loop

Foglio1.audio1.Controls.stop
Foglio1.audio2.Controls.stop
'    Application.ScreenUpdating = False
    Range("K1").Select

Foglio1.audio1.URL = ""
Foglio1.audio2.URL = ""


End Sub

[Anthony47]

Worksheets("menu").Range("P4") = 1
riprendi:
If Worksheets("menu").Range("P4") = 0 Then 'impedisce di continuare il ciclo se stop lo ha impostato su 0
Exit Sub
End If

Con questa sequenza ben difficilmente al momento dell' If P4 sara' mai trovato pari a "zero"
Non ti dico che devi fare il controllo If prima di manipolare la cella, perche' ti darai una manata sulla fronte e lo capirai da solo...
Idem per quanto riguarda la variabile StopNow, anche se non ricordo quale lavoro faceva P4 e quale StopNow, e perche' suggerii due modalita' diverse e non una sola.

Ciao

[wallace&gromit]

Al primo passaggio ovviamente funziona, ma quando arrivo in fondo c'è l'istruzione "GoTo riprendi", quindi se nel frattempo in P4 è stato scritto 0 la macro si chiude.
Il problema è che io vorrei chiudere la macro prima che arrivi al GoTo, infatti per arrivarci deve suonare tutto il brano, che può durare parecchi minuti.

L'ideale sarebbe se un'istruzione della macro chiudiPausa potesse forzare la macro Pausa ad andare al punto "riprendi", dove troverebbe un valore 0 in P4 e si arresterebbe.

[wallace&gromit]

trovato: mi basta aggiungere End prima di End sub nella macro di chiusura e mi arresta tutte le macro in corso.
A questo punto posso anche lasciare perdere la gestione della cella P4 perché so che con End chiudo comunque tutto e finché non arriva End posso continuare i miei loop.