far scorrere in automatico un foglio excel

Question

Saluti a tutti,

Ho da risolvere questa esigenza:

mettiamo che in un foglio Excel nella prima riga B1...BCK1 ho tutte le ventiquattro (00:01, 00:02,... 23:59)

vorrei far scorrere in automatico verso sinistra, mantenendo la colonna A fissa, il foglio in base all'orologio di sistema in maniera

che mi visualizzi al centro l'ora di sistema evidenziata con sfondo diverso (per es. in blu) riga 1.

Grazie per i suggerimenti che dovessero arrivare.....

Answer 1

Ciao Mykia55,

grazie Norman era proprio quello che cercavo.

Ti ringrazio per il cortese riscontro.

Ora se volessi evidenziare non la singola cella con l'orario ma una intera colonna (range 1:100) cosa dovrei modificare ?

Sostituisci:

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

Public Sub EvidenziareMinuto()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim Rng As Range, rcell As Range

    Dim Res As Variant

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

    Const sIntervallo As String = "B1:BCK1"                  '<<=== Modifica

    Set WB = ThisWorkbook

    Set SH = ActiveSheet

    Set Rng = SH.Range(sIntervallo)

    Res = Application.Match((CDbl(Time)), Rng)

    With Rng

        If Not IsError(Res) Then

            Set rcell = .Cells(Res)

        ElseIf Minute(Now) = 0 Then

            Set rcell = .Cells(1)

        End If

        With .Interior

            .Pattern = xlNone

            .TintAndShade = 0

            .PatternTintAndShade = 0

        End With

    End With

    If Not rcell Is Nothing Then

        rcell.Interior.Color = RGB(182, 221, 232)

        Application.Goto rcell, Scroll:=True

    End If

    Call ScrollCentre

    Call StartTimer

End Sub

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

con:

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

   Public Sub EvidenziareMinuto()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim Rng As Range, rcell As Range

    Dim Res As Variant

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

    Const sIntervallo As String = "B1:BCK1"                  '<<=== Modifica

    Const iColAltezza As Long = 100                            '<<=== Modifica

    Set WB = ThisWorkbook

    Set SH = ActiveSheet

    Set Rng = SH.Range(sIntervallo)

    Res = Application.Match((CDbl(Time)), Rng)

    With Rng

        If Not IsError(Res) Then

            Set rcell = .Cells(Res)

        ElseIf Minute(Now) = 0 Then

            Set rcell = .Cells(1)

        End If

        With .Resize(iColAltezza).Interior

            .Pattern = xlNone

            .TintAndShade = 0

            .PatternTintAndShade = 0

        End With

    End With

    If Not rcell Is Nothing Then

        rcell.Resize(iColAltezza).Interior.Color = RGB(182, 221, 232)

        Application.Goto rcell, Scroll:=True

    End If

    Call ScrollCentre

    Call StartTimer

End Sub

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

Ho aggiornato il mio file di prova Mykia20170303.xlsm a:

https://www.dropbox.com/s/litnm4a8jncyzcc/Mykia20170303.xlsm?dl=0

Per chiudere questo thread, vorrei chiederti gentilmente di contrassegnare la mia risposta come Risposta preferita. In questo modo, tu aiuterai anche coloro che potessero cercare soluzioni ai problemi simili negli archivi della Community.

    

===

Regards,

Norman

Answer 2

grazie Norman era proprio quello che cercavo.

Ora se volessi evidenziare non la singola cella con l'orario ma una intera colonna (range 1:100) cosa dovrei modificare ?

Answer 3

Ciao Mykia55,

Ho da risolvere questa esigenza:

mettiamo che in un foglio Excel nella prima riga B1...BCK1 ho tutte le ventiquattro (00:01, 00:02,... 23:59)

vorrei far scorrere in automatico verso sinistra, mantenendo la colonna A fissa, il foglio in base all'orologio di sistema in maniera

che mi visualizzi al centro l'ora di sistema evidenziata con sfondo diverso (per es. in blu) riga 1.

Prova qualcosa del genere:

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

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

Option Explicit

Public RunWhen As Double

Public Const cRunIntervalSeconds = 60    '\   60 Secondi (= 1 Minuto)

Public Const cRunWhat = "EvidenziareMinuto"

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

Public Sub EvidenziareMinuto()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim Rng As Range, rcell As Range

    Dim Res As Variant

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

    Const sIntervallo As String = "B1:BCK1"                  '<<=== Modifica

    Set WB = ThisWorkbook

    Set SH = ActiveSheet

    Set Rng = SH.Range(sIntervallo)

    Res = Application.Match((CDbl(Time)), Rng)

    With Rng

        If Not IsError(Res) Then

            Set rcell = .Cells(Res)

        ElseIf Minute(Now) = 0 Then

            Set rcell = .Cells(1)

        End If

        With .Interior

            .Pattern = xlNone

            .TintAndShade = 0

            .PatternTintAndShade = 0

        End With

    End With

    If Not rcell Is Nothing Then

        rcell.Interior.Color = RGB(182, 221, 232)

        Application.Goto rcell, Scroll:=True

    End If

    Call ScrollCentre

    Call StartTimer

End Sub

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

Public Sub StartTimer()

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

    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 ScrollCentre()

    Dim iCols As Long

    With ActiveWindow

        iCols = .VisibleRange.Columns.Count

        .SmallScroll Toleft:=iCols \ 2

    End With

End Sub

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

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

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

Option Explicit

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

Private Sub Workbook_Activate()

    Application.OnTime _

            EarliestTime:=Now(), _

            Procedure:=cRunWhat, _

            Schedule:=True

    Call StartTimer

End Sub

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

Private Sub Workbook_Deactivate()

    Call StopTimer

End Sub

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

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

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

https://www.dropbox.com/s/litnm4a8jncyzcc/Mykia20170303.xlsm?dl=0

===

Regards,

Norman