Spostamento in giù di una cella dopo un certo tempo

Question

Salve,supponiamo di avere selezionato la cella A1. Dopo un numero di secondi da me stabilito vorrei che automaticamente venga selezionata la cella A2 e dopo altro tempo da me stabilito ma diverso dal primo si sposta alla cella A3 e così via. Si può fare ? grazie

Answer 1

Ciao Adriano,

Benvenuto alla Community!

Salve,supponiamo di avere selezionato la cella A1. Dopo un numero di secondi da me stabilito vorrei che automaticamente venga selezionata la cella A2 e dopo altro tempo da me stabilito ma diverso dal primo si sposta alla cella A3 e così via. Si può fare ? 

Prova qualcosa del genere:

• Fai clic dx sulla linguetta del foglio
• Seleziona l'opzione Visualizza Codice dal **** menu contestuale risultante
• Incolla il seguente codice:

'=========>>

Option Explicit

'--------->>

Private Sub Worksheet_Activate()

    If Not Rng Is Nothing Then

        Call StartTimer

    End If

End Sub

    '--------->>

Private Sub Worksheet_Deactivate()

    Call StopTimer

End Sub

'<<=========

• Alt+IM per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

'=========>>

Option Explicit

Public Rng As Range

Public RunWhen As Double

Dim iSecondi As Long

Public Const cRunWhat = "SelectCell"

'--------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim Sh As Worksheet

    Const sFoglio As String = "Foglio1"                 '<<=== Modifica

    Set WB = ThisWorkbook

    Set Sh = WB.Sheets(sFoglio)

    iSecondi = Application.InputBox( _

               Prompt:="Inserisci il numero di secondi per la pausa", _

               Title:="Pausa", _

               Default:=10, Type:=1)

    If Not CBool(iSecondi) Then

        Call MsgBox( _

             Prompt:="Non hai indicato la durata della pausa desiderata", _

             Buttons:=vbCritical, _

             Title:="REPORT")

        Exit Sub

    End If

    Set Rng = Sh.Range("A1")

    Rng.Select

    Call StopTimer

    Call StartTimer

XIT:

End Sub

'--------->>

Public Sub StartTimer()

    RunWhen = Now + TimeSerial(0, 0, iSecondi)

    Application.OnTime EarliestTime:=RunWhen, _

                       Procedure:=cRunWhat, _

                       Schedule:=True

End Sub

'--------->>

Public Sub StopTimer()

    On Error Resume Next

    Application.OnTime EarliestTime:=RunWhen, _

                       Procedure:=cRunWhat, _

                       Schedule:=False

End Sub

'--------->>

Public Sub SelectCell()

    Set Rng = Rng.Offset(1)

    Rng.Select

    Call StartTimer

End Sub

'<<=========

• Ctrl+R per accedere alla finestra Project Explorer ('Gestione progetti')
• Fai doppio clic sul modulo ThisWorkbook (Questa_cartella_di_Lavoro) del file
• Incolla il seguente codice

'=========>>

Option Explicit

'--------->>

Private Sub Workbook_Deactivate()

    StopTimer

End Sub

'<<========= 

• Alt+Q per chiudere l'editor di VBA e tornare a Excel
• Salva il file con l’estensione xlsm

Potresti scaricare il mio file di prova Adriano20161219.xlsm a:

https://www.dropbox.com/s/njyj1i7z0bh8vw9/Adriano20161219.xlsm?dl=0

===

Regards,

Norman