Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Avviso popup per data scaduta

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

Avviso popup per data scaduta

Postdi BG66 » 08/06/19 22:53

Buonasera,
vorrei che nel caso la data in colonna C fosse scaduta rispetto alla data odierna si aprisse un popup di avviso.
Pensavo di risolverlo con questo script ma non si attiva il popup:
Codice: Seleziona tutto
Private Sub Worksheet_Activate()
Dim ur As Long, i As Long, testo1 As String, testo As String, risp As Integer
Sheets("DB Carrellista").Select
With Sheets("DB Carrellista")
    ur = .Cells(Rows.Count, 1).End(xlUp).Row
    For i = 3 To ur 'ex 7
        If .Cells(i, 4) <> "" And (.Cells(i, 5) = "" And .Cells(i, 6) = "") Then
            testo1 = .Cells(i, 1) & " - " & .Cells(i, 9) & " gg. trascorsi " & vbLf 'copia cognome&nome+gg.trascorsi
            testo = testo & testo1
        End If
    Next i
End With
End Sub


Cosa sbaglio??
https://www.dropbox.com/s/k16kbwzemmn8l2w/DBCarrellista_forum.xlsm?dl=0

Grazie per l'aiuto.
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 200
Iscritto il: 20/08/16 07:44

Sponsor
 

Re: Avviso popup per data scaduta

Postdi Anthony47 » 09/06/19 00:04

Non vedo proprio come quella macro possa aprire un popup...

Prova con
Codice: Seleziona tutto
Private Sub Worksheet_Activate()
Dim NumExc
'
NumExc = Evaluate("sum((C1:C10000 " & "<" & CLng(Now) & ") * (C1:C10000 >0))")
If NumExc > 0 Then
    gloMess = "Ci sono " & NumExc & " date scadute"
    tRTr = Shell("mshta.exe vbscript:close(CreateObject(""WScript.Shell"").Popup(""" & gloMess & """,3,""Informazione:"",64))")
End If
End Sub


All'attivazione del foglio dovrebbe comparire un popup che per 3 secondi segnala che ci sono N date scadute; se non ce ne sono allora non c'e' nessun messaggio.

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

Re: Avviso popup per data scaduta

Postdi BG66 » 09/06/19 07:25

Ciao Anthony,
scusami lo script era purtroppo parziale ed in itinere (posizionamento in This workbook).

A stamani sono arrivato a questo punto:
Codice: Seleziona tutto
Option Explicit

Private Sub Workbook_Open()
Dim ur As Long, i As Long, testo1 As String, testo As String, risp As Integer, j As Integer, flag As Integer

With Sheets("DB_Carrellisti")
    ur = .Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To ur
        flag = 0
        For j = 3 To 6
            If .Cells(i, j) <> "SI" Then flag = 1:  Exit For
        Next j
        If flag = 1 Then
            testo1 = .Cells(i, 1) & " : " & .Cells(i, 9) & " gg. trascorsi " & vbLf
            testo = testo & testo1
        End If
    Next i
End With
If testo <> "" Then
    risp = MsgBox("ATTENZIONE!" & vbLf & "Ci sono dipendenti con corsi scaduti" & vbLf & vbLf & _
        testo & vbLf, vbInformation, "Avviso")
     
End If
End Sub


Il risultato atteso sarebbe l'indicazione che solamente ETA BETA è scaduto ( gg.trascorsi > 0) ma ottengo l'elenco di tutti i lavoratori scaduti e non :cry:

https://www.dropbox.com/s/tn7455f85sk6mcd/DBCarrellista_forum_V1.xlsm?dl=0

PS La parte ...For j = 3 To 6... può lasciarti dei dubbi (anche miei al momento) infatti non mi è chiaro cosa fare, pensavo di mettere un controllo che se i valori sono <> "Si" -> NON tenere conto della scadenza.

Grazie per l'aiuto
Gene
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 200
Iscritto il: 20/08/16 07:44

Re: Avviso popup per data scaduta

Postdi Anthony47 » 09/06/19 12:08

Ahha, mi sembrava che mancasse molto...

Pero' non hai detto quali sono le condizioni che fanno scattare il controllo della data... La verifica <> "SI" che fai sulle colonne C:F (hai notato che col C sara' sempre <> "SI"?) mi fa pensare che va verificata che una delle colonne D:F contenga SI. Pertanto una delle possibili soluzioni:
Codice: Seleziona tutto
Private Sub Workbook_Open()
Dim uR As Long, I As Long, testoMex As String, Risp
'
With Sheets("DB_Carrellisti")
    uR = .Cells(Rows.Count, 1).End(xlUp).Row
    For I = 2 To uR
        If Application.WorksheetFunction.CountIf(.Cells(I, "D").Resize(1, 3), "SI") > 0 Then    '*** Vedi testo
            If .Cells(I, "C") < Int(Now) Then
                testoMex = testoMex & " - " & .Cells(I, 1) & " : " & .Cells(I, 9) & " gg. trascorsi " & vbLf
            End If
        End If
    Next I
End With
If Len(testoMex) > 5 Then
    Risp = MsgBox("ATTENZIONE!" & vbLf & "Ci sono dipendenti con corsi scaduti" & vbLf & _
        testoMex & vbLf, vbInformation, "Avviso")
End If
End Sub

L'istruzione marcata *** controlla che ci sia almeno un SI su quel nominativo; se invece devono esserci tre Si allora modifica da >0 a >2

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

Re: Avviso popup per data scaduta

Postdi BG66 » 09/06/19 18:54

[RISOLTO]

Ciao Anthony,
come al solito...Grazie mille.

Alla prossima.
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 200
Iscritto il: 20/08/16 07:44


Torna a Applicazioni Office Windows


Topic correlati a "Avviso popup per data scaduta":


Chi c’è in linea

Visitano il forum: Nessuno e 27 ospiti