timer in shape

[miko]

salve;
ho inserito il risultato di un cronometro in una cella ed in un textbox di un userform
e tutto funziona perfettamente.
ma se provo a visualizzare il cronometro in uno shape oppure
in un textbox, active-x control, oppure ancora in una label
inseriti nel foglio, non funziona più correttamente,
la progressione dei numeri sembra avanzare a scatti come se ci fosse una pausa,
e non velocemente come avviene ad esempio nella cella.
da cosa dipende questo diverso comportamento?
saluti grazie

[Marius44]

Ciao
Dovresti almeno farci vedere il codice che utilizzi perchè, secondo me, il procedere a "sbalzi" può dipendere da quello.
Ciao,
Mario

[miko]

Buonasera,
ciao mario grazie per il tuo intervento,
secondo me non dipende dalla macro perchè ho provato con altre, ad esempio questa
https://www.pc-facile.com/forum/viewtopic.php?f=26&t=85468&hilit=CRONOMETRO
e si presenta sempre lo stesso problema.
inoltre come scrivevo in precedenza la stessa macro inserita in un form
con 3 pulsanti ed un textbox funziona perfettamente.
tuttavia di seguito la macro attualmente in uso:
nel foglio 1 ho inserito, oltre allo shape del timer, anche altri 3 shape a cui ho associato le 3 sub
in cima al modulo le variabili
la progressione del timer è espresso in microsecondi

Codice: Seleziona tutto

Dim StopIt As Boolean, ResetIt As Boolean

Dim LastTime, Foglio1 As Worksheet

Dim CronoShape As Shape

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub AVVIA_TIMER_CRONOSHAPE() 'PULSANTE START

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim StartTime, FinishTime, totalTime, PauseTime

  '''''''''''''''''''''''''''''''''''''''''''''''''

  Set Foglio1 = ThisWorkbook.Worksheets("Foglio1")

  Set CronoShape = Foglio1.Shapes("CronoShape")
 
  '''''''''''''''''''''''''''''''''''''''''''''''''

  StopIt = False

  ResetIt = False
 
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
  With Foglio1
   
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
    CronoShape.Visible = True
   
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
    If CronoShape.TextFrame _
        .Characters.Text = Format(0, "00") & ":" & _
                           Format(0, "00") & ":" & _
                           Format(0, "00") & "," & _
                           Format(0, "000000") Then
   
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     
      StartTime = Timer
   
      PauseTime = 0
   
      LastTime = 0
     
    '''''''''''''''''''''''''''''''''''''''''''''''''''
   
    Else
 
      ''''''''''''''''''''''''''''''''''''''''''''''''''
     
      StartTime = 0
   
      PauseTime = Timer
   
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
    End If
 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
StartIt:
 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
    DoEvents
 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
    If StopIt = True Then
 
      '''''''''''''''''''''''''''''''''''''''''''
     
      LastTime = totalTime
   
      Exit Sub
   
    ''''''''''''''''''''''''''''''''''''''''
   
    Else
 
      ''''''''''''''''''''''''''''''''''''''''''''''''''
     
      FinishTime = Timer
   
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
         
      totalTime = ((FinishTime - StartTime) + (LastTime - PauseTime))
   
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     
      TTime = (totalTime * 1000000)
   
      ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
      HM = (TTime Mod 1000000)
     
      ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
      TTime = (TTime \ 1000000)
     
      ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
      HH = (TTime \ 36000000)
   
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     
      TTime = (TTime Mod 36000000)
   
      ''''''''''''''''''''''''''''''''''''''''''''''''''''''
     
      MM = (TTime \ 60)
   
      ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     
      SS = (TTime Mod 60)
   
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     
      CronoShape.TextFrame _
       .Characters.Text = Format(HH, "00") & Space(1) & "h" & Space(1) _
                                                    & ":" & Space(1) & _
                          Format(MM, "00") & Space(1) & "m" & Space(1) _
                                                    & ":" & Space(1) & _
                          Format(SS, "00") & Space(1) & "s" & Space(1) _
                          & "," & Format(HM, "000000") & Space(1) & "µs"  'OK
     
      '''''''''''''''''''''''''''''''''''''''''''''''''''
     
      If ResetIt = True Then
   
        ''''''''''''''''''''''''''''''''''''''
       
        CronoShape.TextFrame _
           .Characters.Text = Format(0, "00") & ":" & _
                              Format(0, "00") & ":" & _
                              Format(0, "00") & "," & _
                              Format(0, "000000") 'OK
       
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
               
        LastTime = 0
     
        PauseTime = 0
       
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     
        End
     
      ''''''''''''''''''''''''''''''''''''''''''''''''''''
     
      End If
   
      ''''''''''''''''''''''''''''''''''''''''''''''
   
      GoTo StartIt
   
    ''''''''''''''''''''''''''''''''''''''''''''''
   
    End If
   
  '''''''''''''''''''''''''''''''''''''''''''''''''''''
 
  End With
 
  ''''''''''''''''''''''''''''''''''''''''''''''''''''
 
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub STOP_TIMER_CRONOSHAPE() 'PULSANTE STOP
     
  StopIt = True
 
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub RESET_TIMER_CRONOSHAPE() 'PULSANTE RESET

  Set Foglio1 = ThisWorkbook.Worksheets("Foglio1")

  Set CronoShape = Foglio1.Shapes("CronoShape")
   
  '''''''''''''''''''''''''''''''''''''''''''''
 
  With Foglio1
 
    '''''''''''''''''''''''''''''''''''''''''''''''
       
    CronoShape.TextFrame _
            .Characters.Text = Format(0, "00") & ":" & _
                               Format(0, "00") & ":" & _
                               Format(0, "00") & "," & _
                               Format(0, "000000")  'OK
   
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
    CronoShape.Visible = False
   
    '''''''''''''''''''''''''''''''''''''''''''''''''''
 
    LastTime = 0
 
    ResetIt = True
   
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
  End With
 
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
End Sub


saluti grazie

[Anthony47]

Sul mio pc, non particolarmente recente nè particolarmente potente, l'output sia su una shape che su un textbox activex e' fluido e regolare; credo che dipenda da come il pc gestisce la grafica, cosa che è legata al tipo di scheda grafica installata, quanta memoria e quanta potenza di calcolo sono disponibili.

Se con la userform funziona regolarmente allora sai come risolvere. Eventualmente, se devi usare il foglio mentre il timer (la userform) e' attivo, apri la userform in modalità modeless (UserForm1.Show vbModeless); anche se non escludo che a questo punto (form attiva e foglio attivo) il sistema riprenda a singhiozzare per carenza di risolrse...

[miko]

Buonasera,
credo che tu abbia ragione, perché eseguendo la macro in momenti diversi
la shape mostra risultati veloci, in altri si presenta il problema che avevo descritto.
pazienza.
ho però un altro problema e non capisco da cosa dipenda.
ho modificato la macro precedente come segue inserendo un banale ciclo per verifica

Codice: Seleziona tutto

Sub AVVIA_TIMER_ClockShape()

Dim StartTime, FinishTime, totalTime

Dim Foglio2 As Worksheet, ClockShape As Shape


  Set Foglio2 = ThisWorkbook.Worksheets("Foglio2")

  Set ClockShape = Foglio2.Shapes("ClockShape")


  With Foglio2
 
   ClockShape.Visible = msoTrue    'NON FUNZIONA  <<<<<<<<<<<<<<<<<<
     
    StartTime = Timer
     
    DoEvents
     
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
    'PROCEDURA DA MISURARE IL TEMPO DI ESECUZIONE
   
    For MyVal = 1 To 50000 '0
 
      .Range("D8").Value = MyVal
   
    Next MyVal
   
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
    FinishTime = Timer
   
    totalTime = (FinishTime - StartTime)
   
    TTime = (totalTime * 1000000)
   
    HM = (TTime Mod 1000000)
   
    TTime = (TTime \ 1000000)
   
    HH = (TTime \ 36000000)
   
    TTime = (TTime Mod 36000000)
   
    MM = (TTime \ 60)
   
    SS = (TTime Mod 60)

   ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    'QUI VIENE MOSTRATO LO SHAPE  <<<<<<<<<<<<<<<<<<<<<<<
   
    ClockShape.TextFrame _
       .Characters.Text = Format(HH, "00") & Space(1) & "h" & Space(1) _
                                                    & ":" & Space(1) & _
                          Format(MM, "00") & Space(1) & "m" & Space(1) _
                                                    & ":" & Space(1) & _
                          Format(SS, "00") & Space(1) & "s" & Space(1) _
                          & "," & Format(HM, "000000") & Space(1) & "µs"  'OK
   
    '''''''''''''''''''''''''''''''''''''''''''''''''''''

    MsgBox "Tempo trascorso: " & vbNewLine & vbNewLine & _
              ClockShape.TextFrame.Characters.Text   
   
    ClockShape.TextFrame _
            .Characters.Text = Format(0, "00") & ":" & _
                               Format(0, "00") & ":" & _
                               Format(0, "00") & "," & _
                               Format(0, "000000")
 
    ClockShape.Visible = msoFalse 'FUNZIONA  <<<<<<<<<<<<<<<
     
  End With
   
End Sub



se eseguo la macro step by step la shape viene visualizzata fin dall'inizio
ma se uso il triangolino verde od avvio la macro con un pulsante la shape viene
visualizzata al termine dei calcoli del timer, mentre funziona in ogni caso la linea che nasconde la shape.
nella macro precedente questo problema non esisteva.
non capisco perché.
saluti grazie

[Anthony47]

Prova inserendo piu' di un solo DoEvents; tipo:

Codice: Seleziona tutto

   ClockShape.Visible = msoTrue    'NON FUNZIONA  <<<<<<<<<<<<<<<<<<
    StartTime = Timer
    DoEvents: DoEvents: DoEvents
'etc etc


[miko]

Buongiorno,
funziona grazie, aveva bisogno di una spinta maggiore.
ma ora mi si presenta un altro problema, non previsto pensando si potesse modificare le macro,
che non riesco a risolvere.
la prima macro mostra una progressione continua del tempo, la seconda mostra il risultato finale.
supponiamo di avere una Sub Principale che svolge un certo processo, ad esempio il semplice ciclo

Codice: Seleziona tutto

Sub Principale
For MyVal = 1 To 50000 
      .Range("D8").Value = MyVal   
    Next MyVal
End Sub

durante l'esecuzione di questa Sub Principale é possibile mostrare anche il timer a progressione continua
della Sub AVVIA_TIMER_CRONOSHAPE della prima macro di questo post?
mentre cioè la macro principale esegue le sue istruzioni
compare anche il timer che mostra l'avanzamento del tempo e
quando la macro principale ha terminato, scompare anche il timer.
se questo é possibile come si procede?
grazie

[Anthony47]

Se vuoi vedere altre informazioni allora devi inserire nel loop della Sub Principale anche le istruzioni che mostrano le altre informazioni, copiandole dalla sub che funzionano. Ovviamente a questo punto conviene che dette istruzioni siano incluse in una sub a parte, richiamata sia dalla Sub Principale che dall'altra sub.
Tuttavia bisogna considerare quale e' il tuo obiettivo finale. Perchè se fosse misurare i tempi di esecuzione di altre macro ti deve essere chiaro che la visualizzazione delle informazioni temporali non è un processo a "costo zero", nel senso che richiede a sua volta del tempo, che potrebbe non essere trascurabile rispetto alla macro che si vuole misurare.
In questi casi il mi limito a usare il Timer, che ha una precisione al centesimo di secondo, e per i miei lavori basta. Poi nel mio codice faccio qualcosa del genere

Codice: Seleziona tutto

Sub Principale()

Dim myTim As Single, DBG As Boolean

DBG = False                 'A Oppure true se voglio misurare i tempi
myTim = Timer
'ciclo di istruzioni 1
If DBG Then Debug.Print "Fase1: " & Format(Timer - myTim, "0.00")
'myTim = Timer               'B Scommentare se si vuole calcolare solo il Delta

'ciclo di istruzioni 2
If DBG Then Debug.Print "Fase2: " & Format(Timer - myTim, "0.00")
'myTim = Timer               'B Scommentare se si vuole calcolare solo il Delta


End Sub


Note
A: Quando voglio che i tempi mi siano riportati (nella "finestra Immediata" del vba) impostero DBG=True
B: Se myTim=Timer è "commentata" (come nel codice riportato) il debug mi riporta i tempi cumulativi tra le fasi, compreso il tempo speso per scrivere la riga dui debug; se elimino l'apostrofo allora mi sarà visualizzato solo il tempo di esecuzione del codice

Per esaminare il contenuto del debug bisogna aprire la "finestra Immediata" del vba: dalla finestra del vba, Contr-g dovrebbe bastare; oppure Menu /Visualizza /Finestra Immediata