MsgBox riepilogativo

[sprinterone]

Buongiorno, ho trovato in rete questa macro di ricerca dati che farebbe al caso mio:

Private Workbook_Open()

Application.ScreenUpdating = False
Worksheets("attivita").Select

Dim data
Dim avviso As Object
Dim Lem As String

Set data = Worksheets("attivita").Range([V1], [V1].End(xlDown))

For Each avviso In data
Cliente = avviso.Offset(1, -19).Value
Polizza = avviso.Offset(1, -14).Value
Compagnia = avviso.Offset(0, -21).Value

If avviso = Date > 30 Then
MsgBox " nessuna polizza in scadenza "
End If
If avviso = Date + 30 Then
MsgBox " Sono in scadenza a 30 gg " & vbCrLf & _
"Cliente : " & Cliente & " Polizza n° : " & Polizza & " Compagnia : " & Compagnia
' pippo = MsgBox("Mancano 30 gg alla scadenza. Vuoi inviare gli avvisi ?", vbYesNo)
' Else
' Call macro
End If
Application.ScreenUpdating = True

Next

End Sub

Adattato alle mie esigenze,provato ,funziona.
1-E' possibile evitare che apra a video il foglio dove verifica i dati (vorrei che rimanesse la maschera iniziale del file)?
2-Sarebbe possibile ,anziche' piu msgbox in sequenza ,che comparisse un unico messaggio a piu "righe" dei dati trovati?
Grazie anticipate.

[Anthony47]

Per evitare che si debba aprire il foglio "attivita" puoi inserire un With /End With attorno al tuo loop; per avere un unico messaggio basta memorizzare i singoli messaggi e produrre un unico msgbox alla fine.
Non so valutare il significato del test If avviso = Date > 30 Then /End If, quindi l' ho lasciato come l' hai messo tu.
La macro modificata diventa:

Codice: Seleziona tutto

Private Workbook_Open()
'
'Application.ScreenUpdating = False
'Worksheets("attivita").Select

Dim data
Dim avviso As Object
Dim Lem As String, Msg As String

With Sheets("attivita")
    Set data = .Range(.[V1], .[V1].End(xlDown))
    Msg = "Sono in scadenza a 30 gg " & vbCrLf
    For Each avviso In data
        Cliente = avviso.Offset(1, -19).Value
        Polizza = avviso.Offset(1, -14).Value
        Compagnia = avviso.Offset(0, -21).Value
'       
        If avviso = Date > 30 Then
            MsgBox " nessuna polizza in scadenza "
        End If
        If avviso = Date + 30 Then
            Msg = Msg & "Cliente : " & Cliente & " Polizza n° : " & Polizza & " Compagnia : " & Compagnia & vbCrLf
            ' pippo = MsgBox("Mancano 30 gg alla scadenza. Vuoi inviare gli avvisi ?", vbYesNo)
            ' Else
            ' Call macro
        End If
    Next
End With
'Application.ScreenUpdating = True
MsgBox (Msg)
End Sub


In caso di nessuna scadenza a esattamente 30 gg (di calendario) il msgbox riporta un elenco vuoto.

Sei sicuro di quei +1 sull' Offset di riga rispetto alla data?

Ciao

[sprinterone]

Ciao Anthony, grazie dell'aiuto velocissimo.
Ho qualche problema a rispondere da telefono, il forum non mi riconosce la pwd che uso da desktop...
Ho sistemato "If avviso = Date > 30 Then" con "If avviso > Date + 30 Then" per attivare msg di scadenze non trovate, cosi in teoria dovrebbe uscire dalla macro se non trova corrispondenze ed evitare il msg vuoto.
Credo pero' proprio di aver toppato sulla definizione del Range di verifica date in scadenza... nel mio file sono nella colonna R.
Ho provato con Set data = Range ("R2:R1000") ma non mi trova l'unica data inserita appositamente per verificare la macro.
Un indizio?
Grazie

[sprinterone]

Private Sub Workbook_Open()
'
Dim data
Dim avviso As Object
Dim Lem As String, Msg As String

With Sheets("attivita")
' Set data = .Range(.[R2], .[R2].End(xlDown)) ' colonna date scadenza dalla 2a riga
Set data = Sheets("attivita").Range(Cells(2, 18), Cells(2, 18).End(xlDown)) ' idem

Msg = "Sono in scadenza a 30 gg :" & vbCrLf
For Each avviso In data
Cliente = avviso.Offset(1, -15).Value
Polizza = avviso.Offset(1, -10).Value
Compagnia = avviso.Offset(1, -17).Value

If avviso > Date + 30 Then
MsgBox " nessuna polizza rilevata ", vbOKOnly, "VERIFICA SCADENZE POLIZZE"
End If

If avviso = Date + 30 Then
Msg = Msg & "Cliente : " & Cliente & " Polizza n° : " & Polizza & " Compagnia : " & Compagnia & vbCrLf
' pippo = MsgBox("Mancano 30 gg alla scadenza. Vuoi inviare gli avvisi ?", vbYesNo)
' Else
' Call macro
End If
Next
End With
MsgBox (Msg)
End Sub

Ciao Anthony, reinvio la macro.Ho provato entrambe le righe di codice in grasssetto,ma non mi ritorna il controllo della colonna "R" (date da verificare).
A video compare piu' volte il msg di "nessuna polizza" , poi alla fine il msg vuoto di scad.trovate.
Dove sbaglio ?
Grazie per la pazienza

[Anthony47]

Ho sistemato "If avviso = Date > 30 Then" con "If avviso > Date + 30 Then" per attivare msg di scadenze non trovate

Non credo che l' effetto che ottieni sia quello che intendi... cancella le tre istruzioni dell' If.

Ho provato con Set data = Range ("R2:R1000") ma [. . . ]

Con quella sintassi "data" fara' riferimento al foglio attivo all' apertura del file; e' corretta la versione Set data = .Range(.[R2], .[R2].End(xlDown))
Con questo range di controllo la macro sara'

Codice: Seleziona tutto

Private Workbook_Open()
Dim data
Dim avviso As Object
Dim Lem As String, Msg As String
'
With Sheets("attivita")
Set data = .Range(.[R2], .[R2].End(xlDown))
    Msg = "Sono in scadenza a 30 gg: " & vbCrLf
    For Each avviso In data
        Cliente = avviso.Offset(1, -19).Value
        Polizza = avviso.Offset(1, -14).Value
        Compagnia = avviso.Offset(0, -21).Value
'
        If avviso = Date + 30 Then
            Msg = Msg & "Cliente : " & Cliente & " Polizza n° : " & Polizza & " Compagnia : " & Compagnia & vbCrLf
            ' pippo = MsgBox("Mancano 30 gg alla scadenza. Vuoi inviare gli avvisi ?", vbYesNo)
            ' Else
            ' Call macro
        End If
    Next
End With
Application.ScreenUpdating = True
If Len(Msg) = 28 Then Msg = "Nessuna scadenza a 30 gg"
MsgBox (Msg)
End Sub


E' previsto un messaggio specifico per " Nessuna scadenza a 30 gg".

Sia chiaro che questa macro ti restituisce solo le scadenze a esattamente 30 gg di calendario da oggi. Lo sai che se salti un giorno le scadenze di quel giorno non le visualizzerai piu'? Lo sai che ad ogni week-end salti tutte le scadenze che erano a 30 gg dal sabato e 30 gg dalla domenica?
Sei sicuro che sia quello che vuoi?

Ciao

[sprinterone]

Grazie alla tua nota (e ad una sbirciatina in questo stupendo forum.. )ho modificato in:

If avviso = Date + 30 Or avviso = Date + 31 Or avviso = Date + 32 Then

e funziona.
Ora vorrei personalizzare il nome del msgbox (Microsoft Excel)con

Msg = "Sono in scadenza a 30 gg: " & vbCrLf & vbCrLf + vbInformation, "Alert Scadenze"

ma mi da errore.Eppure in altre macro mi funziona.
Ultimo quesito: se e come si puo' inserire

Msg =("Mancano 30 gg alla scadenza. Vuoi inviare gli avvisi ?",vbYesNo)=vbYes Then

con questo tipo di messaggio? mi da errore di compilazione....
Grazie

[Anthony47]

ho modificato in:

Codice: Seleziona tutto

If avviso = Date + 30 Or avviso = Date + 31 Or avviso = Date + 32 Then

e funziona.

Non per deluderti, ma ora ti ripetera' "oggi" anche le scadenze che ti diede "ieri e l' altro ieri".

Ora vorrei personalizzare il nome del msgbox (Microsoft Excel)con

Codice: Seleziona tutto

Msg = "Sono in scadenza a 30 gg: " & vbCrLf & vbCrLf + vbInformation, "Alert Scadenze"

ma mi da errore

Questa sintassi e' alquanto avventurosa... Lascia stare la composizione del messaggio (la variabile Msg) e, invece di MsgBox (Msg), usa:
pippo = MsgBox(Msg, vbInformation)

Quanto all' invio di email, tu hai chiesto di avere un "riepilogativo" di scadenze; alla fine vuoi inviare un messaggio "riepilogativo" o dettagliato a ognuno dei riferimenti con scadenza?

Ciao