Scadenzario che avverte

Ciao a tutti,
Confido nel vostro aiuto per avere la possibilità di accelerare il mio lavoro. Nel forum ho trovato questo codice:
Private Sub Worksheet_Change(ByVal Target As Range)
    'dichiaro la variabile oggetto
    Dim rng As Range
    'metto un riferimento al range dove
    'effettuo le modifiche
    Set rng = Me.Range("A1:A10")
        'se modifico una cella del range specificato
        If Not Intersect(Target, rng) Is Nothing Then
            'modifico la data nella colomma C
            Target.Offset(0, 3).Value = Date
        End If
        'Set a Nothing della variabile oggetto
    Set rng = Nothing
End Sub
Lo uso per inserire la data del cliente che riporto nella colonna A. La mia domanda è, si può aggiungere al codice la possibilità nel momento in cui apro la cartella che una msgbox mi avverte quali sono quei nominativi che hanno superato 15 giorni dal momento in cui è stata riportata la data?
Chiedo troppo se ad esempio nello specifico mi dice il nome e quanti giorni sono passati? Grazie.
 

Informazioni domanda


Ultimo aggiornamento febbraio 27, 2018 Visualizzazioni 433 Si applica a:
Risposta

Ciao Geacs,

Nel modulo This workbook, incolla:

'=========>>
Option Explicit

'--------->>
Private Sub Workbook_Open()
    Dim SH As Worksheet
    Dim Rng As Range
    Dim lng As Long, iCtr As Long
    Dim lDiff As Long, sStr As String
    Dim s As String, aStr As String, sMsg As String
    Const myMin As Long = 15

    Set SH = Me.Worksheets("Foglio1")
    With SH
        For lng = 1 To 10
            Set Rng = .Range("C" & lng)
            If IsDate(Rng.Value) Then
                lDiff = DateDiff("d", Rng.Value, Now)
                If lDiff > myMin Then
                    iCtr = iCtr + 1
                    aStr = IntervalloTraDati(.Range("C" & lng).Value, Now())
                    sStr = sStr & vbNewLine & .Range("A" & lng).Value _
                           & " superato di: " _
                           & aStr & vbNewLine
                End If
            End If
        Next lng
    End With
    If sStr = vbNullString Then
        sMsg = "Non ci sono delle scadenze!"
    Else
        sMsg = "Ci sono " & iCtr & " Scadenze:" & vbNewLine & sStr
    End If
    Call MsgBox(Prompt:=sMsg, _
                Buttons:=vbInformation, _
                Title:="SCADENZE")
End Sub
'<<=========

In un modulo standard, incolla la seguente funzione:

'=========>>
Option Explicit
Public Function IntervalloTraDati(d1 As Date, d2 As Date) As String
    Dim dDate As Date
    Dim i As Double
    Dim yr As Long, mnth As Long, dy As Long
    Dim sOutput() As String

    Do Until dDate > d2
        i = i + 1
        dDate = DateAdd("m", i, d1)
    Loop

    i = i - 1
    dDate = DateAdd("m", i, d1)

    yr = Int(i / 12)
    mnth = i Mod 12
    dy = d2 - dDate

    ReDim sOutput(0 To -(yr > 0) - (mnth > 0) - (dy > 0) - 1)
    i = 0
    If yr > 0 Then
        sOutput(i) = yr & IIf(yr = 1, " Anno", " Anni")
        i = i + 1
    End If
    If mnth > 0 Then
        sOutput(i) = mnth & IIf(mnth = 1, " Mese", " Mesi")
        i = i + 1
    End If
    If dy > 0 Then sOutput(i) = dy & IIf(dy = 1, " Giorno", " Giorni")

    IntervalloTraDati = Join(sOutput, ", ")

End Function
'<<=========

===

Regards,

Norman 

Il problema è stato risolto?

Siamo spiacenti che questo non sia stato d'aiuto.

Fantastico! Grazie per aver scelto questa risposta.

Sei soddisfatto di questa risposta?

Grazie per il tuo commento, ci aiuta a migliorare il sito.

Sei soddisfatto di questa risposta?

Grazie per il tuo commento.

Risposta
Ciao a tutti,
Confido nel vostro aiuto per avere la possibilità di accelerare il mio lavoro.
<cut>
Lo uso per inserire la data del cliente che riporto nella colonna A. La mia domanda è, si può aggiungere al codice la possibilità nel momento in cui apro la cartella che una msgbox mi avverte quali sono quei nominativi che hanno superato 15 giorni dal momento in cui è stata riportata la data?
Chiedo troppo se ad esempio nello specifico mi dice il nome e quanti giorni sono passati? Grazie.


Se(se) ho capito, copia/incolla questo nel modulo di codice di ThisWorkbook (o Questa_cartella_di_lavoro per le versioni più recenti di Excel):

 

Private Sub Workbook_Open()

    Dim sh As Worksheet
    Dim lng As Long
    Dim lDiff As Long
    Dim s As String
   
    Set sh = ThisWorkbook.Worksheets("Foglio1")
    With sh
        For lng = 1 To 10
            lDiff = DateDiff("d", .Range("C" & lng).Value, Now)
            If lDiff > 15 Then
                s = s & .Range("A" & lng).Value & _
                    " superato di gg: " & lDiff & vbNewLine
            End If
        Next
    End With
   
    MsgBox s
   
    Set sh = Nothing

End Sub

 

Modifica il nome del foglio ed i riferimenti delle celle con i tuoi.

Ma, domanda mia, perché non colori le scadenze con una formattazione condizionale?

 

Selezioni il range di celle in colonna C e poi come regola della formattazione condizionale:

 

=C1+15<OGGI()

 

formattando a piacere.

--
Mauro Gamberini
Microsoft© MVP (Excel)
http://www.maurogsc.eu

Il problema è stato risolto?

Siamo spiacenti che questo non sia stato d'aiuto.

Fantastico! Grazie per aver scelto questa risposta.

Sei soddisfatto di questa risposta?

Grazie per il tuo commento, ci aiuta a migliorare il sito.

Sei soddisfatto di questa risposta?

Grazie per il tuo commento.