Avviso popup per data scaduta

[BG66]

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.

[Anthony47]

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

[BG66]

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

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

[Anthony47]

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

[BG66]

[RISOLTO]

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

Alla prossima.