Condividi:        

ferma macro

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

ferma macro

Postdi nicola_na78 » 10/03/11 14:15

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
nicola_na78
Utente Senior
 
Post: 186
Iscritto il: 11/06/10 15:26

Sponsor
 

Re: ferma macro

Postdi Anthony47 » 10/03/11 14:18

Ma quale macro vuoi fermare quando premi il pulsante?

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: ferma macro

Postdi nicola_na78 » 10/03/11 14:54

cioè????
nicola_na78
Utente Senior
 
Post: 186
Iscritto il: 11/06/10 15:26

Re: ferma macro

Postdi nicola_na78 » 10/03/11 14:55

ciao anthony,

premendo un pulsante dovrei stoppare una macro che è in esecuzione....
nicola_na78
Utente Senior
 
Post: 186
Iscritto il: 11/06/10 15:26

Re: ferma macro

Postdi Anthony47 » 10/03/11 23:36

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
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: ferma macro

Postdi nicola_na78 » 11/03/11 14:05

ho eseguito alla lettera le tue istruzioni ma non funziona..... premo sul pulsante ma nn succede niente..... ciao
nicola_na78
Utente Senior
 
Post: 186
Iscritto il: 11/06/10 15:26

Re: ferma macro

Postdi Anthony47 » 11/03/11 14:38

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
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: ferma macro

Postdi nicola_na78 » 11/03/11 16:50

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


grazie ciao
nicola_na78
Utente Senior
 
Post: 186
Iscritto il: 11/06/10 15:26

Re: ferma macro

Postdi Anthony47 » 11/03/11 20:23

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
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: ferma macro

Postdi nicola_na78 » 14/03/11 12:41

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
nicola_na78
Utente Senior
 
Post: 186
Iscritto il: 11/06/10 15:26

Re: ferma macro

Postdi Anthony47 » 14/03/11 15:35

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
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: ferma macro

Postdi nicola_na78 » 14/03/11 16:11

ciao antony, mi da un mess con errore di runtime........
ma qualcosa tipo exit sub non esiste???? grazie x la tua pazienza..... ciao
nicola_na78
Utente Senior
 
Post: 186
Iscritto il: 11/06/10 15:26

Re: ferma macro

Postdi Anthony47 » 14/03/11 17:37

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
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: ferma macro

Postdi wallace&gromit » 23/09/15 14:49

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
Office2016 + 2019 su win11
Avatar utente
wallace&gromit
Utente Senior
 
Post: 2174
Iscritto il: 16/01/12 14:21

Re: ferma macro

Postdi Anthony47 » 24/09/15 00:27

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
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: ferma macro

Postdi wallace&gromit » 24/09/15 13:44

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.
Office2016 + 2019 su win11
Avatar utente
wallace&gromit
Utente Senior
 
Post: 2174
Iscritto il: 16/01/12 14:21

Re: ferma macro

Postdi wallace&gromit » 24/09/15 15:57

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.
Office2016 + 2019 su win11
Avatar utente
wallace&gromit
Utente Senior
 
Post: 2174
Iscritto il: 16/01/12 14:21


Torna a Applicazioni Office Windows


Topic correlati a "ferma macro":


Chi c’è in linea

Visitano il forum: Nessuno e 42 ospiti