Attivare macro tempo

[Gianca532011]

Ciao e Buon anno a tutti.

Scrivo qui perchè ho riscoperto una chicca di Anthony che ho difficoltà ad applicare , prelevata qui :
viewtopic.php?f=26&t=96930&p=556271#p556264)

Ne ho fatto un test dove anzichè attivare una macro dovrebbe darmi un msgbox.ma si inchioda !
Allego immagine e file test con le macro.

http://www.filedropper.com/test_24400

lavoro con excel 2016 e win 10 64 bit .
grazie a chi vorrà risolvere il problema , magari con spiegazione breve sui miei errori. Oppure se mi segnalate qualche alternativa altrettanto valida.

[Anthony47]

Pero' la prossima volta parti da quanto pubblicato, poi piano piano ci fai prove e migliorie...

Hai dichiarato myOre As Range, ma "A2:A10" e' una stringa
Usi Wb.Sh1.Range(myOre), ma Wb non e' assegnato a niente, e Sh1 lo hai gia' associato a un preciso Sheet del workbook attivo, non puoi riassociarlo a un Workbook, nemmeno ripetere l'associazione al workbook attivo; la mia macro faceva riferimento a ThisWorkbook.Sheets(mySh).Range(myOre), cioe' il file che contiene la macro, lo sheet che ha un nome preciso, un range che ha un indirizzo preciso. L'uso di ThisWorkbook consente di associare chiaramente a quale workbook la macro fa riferimento, perche' non devi dimenticare che quando scatta la macro di OnTime tu non puoi prevedere quale sara' in quel momento il file attivo.

Ma comunque se vuoi per prova far comparire un msgbox a una certa ora ti basterebbe una cosa piu' semplice. Tipo
-in A2 del foglio Orari scrivi l'ora a cui vuoi far comparire il messaggio
-in un Modulo standard del vba inserisci la macro che pianifica la macro col msgbox

Codice: Seleziona tutto

Sub Prepara()
    Application.OnTime Sheets("Orari").Range("A2").Value, "Messaggia"
End Sub


Sempre in un Modulo standard scrivi la macro che fara' comparire il messaggio; tipo

Codice: Seleziona tutto

Sub messaggia()
Beep
MsgBox ("Beep...")
End Sub


Poi lanci la Sub Prepara e aspetti che scatti la Sub messaggia, all'ora impostata

Ciao

[Gianca532011]

Grazie Anthony, corretto il tutto e... perfettamente funzionante . Ripropongo le macro a futura memoria .

Codice: Seleziona tutto

Option Explicit
 
Private Sub Workbook_Open()    ' mettere in "questa cartella di lavoro"
Dim Wb As Workbook
 Dim myOre As String
 Dim Sh1 As Worksheet
 Dim Sh2 As Worksheet
 Dim COra As Date
 Dim mysec As Date
 Dim cell As Range
 Dim mySh As String

Application.DecimalSeparator = "."
    Application.ThousandsSeparator = ","
   Application.UseSystemSeparators = False
 
Set Wb = Workbooks("06AA_2020_AzioniITA_Auto_Storico .xlsm")  '<<<correggere con propri riferimenti
Set Sh1 = Sheets("Orari")   ' <<< Il Foglio che contiene myOre   <<<correggere         idem
 myOre = "A2:A10"               ' <<< L' area in cui sono elencati gli orari di esecuzione idem
 mySh = "Orari"
 Sh1.Activate
 
     Application.ScreenUpdating = False
       
Sh1.Range("A2:A10").Interior.ColorIndex = xlColorIndexNone
mysec = Timer / 10
COra = 10 * TimeSerial(0, 0, mysec + 1)
For Each cell In Sh1.Range("A2:A10")
If cell.Value > COra Then
Application.OnTime (cell.Value), "Riesegui"
cell.Interior.ColorIndex = 4
Exit For
End If
Next cell

Set Wb = Nothing
Set Sh1 = Nothing

End Sub


Codice: Seleziona tutto

Option Explicit
Sub Riesegui()  ' in un modulo
 Dim Wb As Workbook
 Dim myOre As String
 Dim Sh1 As Worksheet
 Dim COra As Date
 Dim cell As Range
 Dim mySh As String
 Dim mysec As Date
Set Wb = Workbooks("06AA_2020_AzioniITA_Auto_Storico .xlsm")  '<<<correggere
Set Sh1 = Sheets("Orari")   '<<<correggere
 Sh1.Activate
 
 Call Copiaweb '<<<< correggere con propria macro da attivare
 'MsgBox "Ok"
'Pianifica la prossima esecuzione:
myOre = "A2:A10"    '<<< L' area in cui sono elencati gli orari di esecuzione
mySh = "Orari"    '<<< Il Foglio che contiene myOre

Sh1.Range(myOre).Interior.ColorIndex = xlNone
mysec = Timer / 10
COra = 10 * TimeSerial(0, 0, mysec + 1)
For Each cell In Wb.Sheets("Orari").Range(myOre)
    If cell.Value > COra Then
        Application.OnTime (cell.Value), "Riesegui"
        cell.Interior.ColorIndex = 4
        Exit For
    End If
Next cell
'**
End Sub


se noti altre "magagne" fai sapere . Ancora grazie . ciao, alla prossima .

[Gianca532011]

Il pregio evidente di questa tua macro è che mi permette di attivare excel la mattina, per es alle 8,30 , predisporre gli orari di scarico dati ad.es alle 9,10 e alle 17,30 ; minimizzare excel e -dimenticarlo - facendo altro sul PC .
Gli orari dati sono rispettivamente l di Apertura e chiusura della Borsa .

[Gianca532011]

Ciao Anthony, faccio seguito a quanto detto più sopra per chiederti se conosci un modo da VBA per riattivare un PC che è in risparmio energetico ? Spiego, con la procedura VBA sopra riportata imposto orari di scarico dati, Ok, ma mi sono accorto che se il Pc va in risparmio energetico all'ora prefissata non fa nulla, ovviamente . Quindi il sistema non è perfetto. seconde te c'è modo di simulare la pressione di un tasto ( esc ) 2 minuti prima dell'ora di scarico ? o altri sistemi ?

Possibilmente senza fare ricorso a sw esterni o a windows. la vedo dura .

[Gianca532011]

Probabilmente mi piace l'impossibile, però a chiedere non c'è nulla di male , o no ?
provo a rispondermi da solo :
1)se il Pc è in risparmio energetico - non potrà mai lanciare una macro ,
2) per riattivare il pc in automatico occorrono programmi tipo Zcron o simili oppure la pianificazione di Windows.
Ma il problema è che dovrei abbinare X. ripartenze con un anticipo di 1-2 minuti rispetto agli X orari che ho messo nel foglio Excel .
Quindi ? boh .

Unica alternativa, ma è un embrione d'idea, è di non permettere il risparmio energetico se c'è una applicazione aperta.

[Gianca532011]

Allora , ho fatto qualche progresso nel senso che sono riuscito , quando ho un intervallo valorizzato nel Foglio Orario , a evitare che il PC NON vada in risparmio energetico lanciando un eseguibile Insomnia.exe .
Però altro immediato problema, quando salvo e chiudo vorrei che si chiudesse anche questo eseguibile. Ma ad oggi pur con tutti gli esperimenti fatti non ci sono riuscito. Metto le macro aggiuntive.

Codice: Seleziona tutto

Public Sub chiudi_excel()
          ActiveWorkbook.Save
         With Application
        .DisplayAlerts = False
         ActiveWorkbook.Close
        .DisplayAlerts = True
    End With
     ' qui vorrei aggiungere anche la chiusura dell'icona precedentemente aperta "Insomnia.exe" con la shell vedi sotto
   
End Sub
 
 Sub carica() ' attiva programma Insommnia
Dim Programma As String
Dim Wb As Workbook
 Dim Uriga As Long
 Dim rn As Range
 Dim Sh1 As Worksheet
 
Set Wb = Workbooks("FTSEMIB_Storico3 .xlsm")  '<<<correggere
Set Sh1 = Sheets("Orari")   '<<<correggere
  Sh1.Activate
    Uriga = Range("a2:a21").Cells.Count - Application.WorksheetFunction.CountIf(Range("A2:a21"), "")
      If Uriga = 0 Then Exit Sub
        If Uriga >= 1 Then
        Programma = "C:\Sveglia_PC\Insomnia.exe" 'Da modificare col proprio percorso
        'Shell Programma, vbNormalFocus  ' icona  normale
       
       Shell Programma, vbMinimizedFocus ' minimizza sulla tray
               
         End If

End Sub



[Gianca532011]

Correggo la frase sopra : "Allora , ho fatto qualche progresso nel senso che sono riuscito , quando ho un intervallo valorizzato nel Foglio Orario , a evitare che il PC VADA in risparmio energetico lanciando un eseguibile Insomnia.exe .

Proseguendo nei miei tentativi ho notato che se uso :

Codice: Seleziona tutto

Shell Programma, vbNormalFocus  ' icona  normale 

, resta sempre a Video oltre che sulla barra di comando è dà fastidio, anche se poi scompare quando chiudo .
se la minimizzo con :

Codice: Seleziona tutto

Shell Programma, vbMinimizedFocus ' minimizza sulla tray bar

non viene rimossa quando chiudo il file .
Che fare ? hai qualche coniglio nel cappello ? allego esempio test .

http://www.filedropper.com/funzioneshellm

e il file completo .

http://www.filedropper.com/ftsemibstorico3

infine la cartella che contiene Insomnia.exe

http://www.filedropper.com/svegliapc

[Gianca532011]

Alla fine ne sono venuto a capo, adesso funziona tutto, nel senso che quando chiudo e salvo il file excel si chiude anche l'eseguibile che tiene sveglio il PC impedendo quindi che vada in Risparmio energetico e quindi si inceppi la macro di attivazione a ore precise.

quindi la macro chiudi diventa

Codice: Seleziona tutto

Public Sub chiudi_excel()
   
 Application.DisplayAlerts = False
 ThisWorkbook.Save
  TerminateProcess
  ActiveWorkbook.Close
   Application.DisplayAlerts = True

End Sub

e la macro di chiusura dei file "exe" esterni a Excel è :

Codice: Seleziona tutto

Sub TerminateProcess()
     '---------------------------------------------------------------------------------------
     '              : Terminates a process. First checking to see if it is running or not.
     '              : Uses WMI (Windows Management Instrumentation) to query all running processes
     '              : then terminates ALL instances of the specified process
     '              : held in the variable strTerminateThis.
     '              :
     '              : ***WARNING: This will terminate a specified running process,use with caution!.
     '              : ***Terminating certain processes can effect the running of Windows and/or
     '              : ***running applications.
     '---------------------------------------------------------------------------------------
    Dim strTerminateThis As String 'The variable to hold the process to terminate
    Dim objWMIcimv2 As Object
    Dim objProcess As Object
    Dim objList As Object
    Dim intError As Integer
     Dim pausa As Long
     Dim oraattuale As Date
     
    strTerminateThis = "Insomnia.exe" 'Process to terminate,
     'change notepad.exe to the process you want to terminate
     
    Set objWMIcimv2 = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\.\root\cimv2") 'Connect to CIMV2 Namespace
     
    Set objList = objWMIcimv2.ExecQuery _
    ("select * from win32_process where name='" & strTerminateThis & "'") 'Find the process to terminate
     
     
    If objList.Count = 0 Then 'If 0 then process isn't running
        MsgBox strTerminateThis & " is NOT running." & vbCr & vbCr _
        & "Exiting procedure.", vbCritical, "Unable to continue"
        Set objWMIcimv2 = Nothing
        Set objList = Nothing
        Set objProcess = Nothing
        Exit Sub
    ElseIf objList.Count <> 0 Then
         ''Ask if OK to continue
        'Select Case MsgBox("Are you sure you want to terminate this running process?:" _
        '    & vbCrLf & "" _
        '    & vbCrLf & "Process name: " & strTerminateThis _
        '    & vbCrLf & "" _
        '    & vbCrLf & "Note:" _
        '    & vbCrLf & "Terminating certain processes can effect the running of Windows" _
        '    & "and/or running applications. The process will terminate if you OK it, WITHOUT " _
        '    & "giving you the chance to save any changes in anything that is running in the specified process above." _
        '    , vbOKCancel Or vbQuestion Or vbSystemModal Or vbDefaultButton1, "WARNING:")
             
       ' Case vbOK
             'OK to continue with terminating the process
            For Each objProcess In objList
                 
                intError = objProcess.Terminate 'Terminates a process and all of its threads.
                 'Return value is 0 for success. Any other number is an error.
                If intError <> 0 Then
                    MsgBox "ERROR: Unable to terminate that process.", vbCritical, "Aborting"
                    Exit Sub
                End If
            Next
             'ALL instances of specified process (strTerminateThis) has been terminated
            'Call MsgBox("ALL instances of process " & strTerminateThis & " has been successfully terminated.", _
            'vbInformation, "Process Terminated")
             
            Set objWMIcimv2 = Nothing
            Set objList = Nothing
            Set objProcess = Nothing
            Exit Sub
            Else
            'Else: vbCancel
        'Case vbCancel
             'NOT OK to continue with the termination, abort
            Set objWMIcimv2 = Nothing
            Set objList = Nothing
            Set objProcess = Nothing
            Exit Sub
       ' End Select
    End If
     pausa = 10
oraattuale = Timer
Do While Timer < oraattuale + pausa
DoEvents
Loop
End Sub



qui il link con riferimento al sito da dove ho prelevato.
http://www.vbaexpress.com/kb/getarticle.php?kb_id=811

[Gianca532011]

In conclusione (spero) aggiungo stesura finale del file , ricordo che per funzionare si dovrà aggiungere la cartella " Sveglia_PC "sul disco C: ( vedi post 260) che contiene l'eseguibile Insomnia.exe , ovvero il file che non permette al PC di andare in risparmio energetico.



http://www.filedropper.com/ftsemibstorico3_1

[Anthony47]

Bravo, e grazie per la condivisione