POPUP DI AVVISO SCADENZA CON INFORMAZIONI FOGLIO

[FROST220684Partecipante FROST220684]

Salve a tutti,

Spero possiate darmi una mano, nel file allegato ho inserito 12 fogli ognuno con il mese di riferimento. Ho evidenziato delle celle nel mese di Gennaio dove ho inserito delle date di scadenza. ho gia inserito una formattazione condizionale che mi colora la cella di rosso se la data in questione è successiva ad una settimana. Il problema sta qui fino a quando mi ritrovo nel foglio del mese di riferimento non ci sono problemi perchè la cella diventa rossa ma quando passo al mese successivo avrei bisogno che mi avvertisse che le date negli altri fogli sono in scadenza. Faccio un esempio pratico:

Sono al 11/02/2020, Nel mese di Gennaio ho inserito un prodotto con scadenza il 18/02/2020 è possibile far uscire un popup che mi avvisa della scadenza imminente anche se inserita in un altro foglio?

 

Spero di essere stato chiaro. Grazie mille a tutti

Allegati:

You must be logged in to view attached files.

[patelModeratore patel Karma: 51 pts]

devi utilizzare l'evento Workbook_SheetChange, in cui andrai a controllare i dati del foglio precedente o precedenti ed in caso di scadenza aprire un msgbox

[FROST220684Partecipante FROST220684]

Salve Patel,

Smanettando un po ho trovato questo codice

Private Sub Workbook_Open()
Select Case Cells(29, 1)
    Case Is = Date
        MsgBox "La data della cella A1  in scadenza oggi", vbExclamation, "ATTENZIONE"
    Case Is = Date + 1
        MsgBox "Manca 1 giorno alla scadenza indicata nella cella A1", vbExclamation, "ATTENZIONE"
    Case Is = Date + 2
        MsgBox "Manca 2 giorni alla scadenza indicata nella cella A1", vbExclamation, "ATTENZIONE"
    Case Is = Date + 3
        MsgBox "Manca 3 giorni alla scadenza indicata nella cella A1", vbExclamation, "ATTENZIONE"
    Case Is = Date + 4
        MsgBox "Manca 4 giorni alla scadenza indicata nella cella A1", vbExclamation, "ATTENZIONE"
    Case Is = Date + 5
        MsgBox "Manca 5 giorni alla scadenza indicata nella cella A1", vbExclamation, "ATTENZIONE"
    Case Is = Date + 6
        MsgBox "Manca 6 giorni alla scadenza indicata nella cella A1", vbExclamation, "ATTENZIONE"
    Case Is = Date + 7
        MsgBox "Manca 7 giorni alla scadenza indicata nella cella A1", vbExclamation, "ATTENZIONE"
    Case Is = Date + 8
        MsgBox "Manca 8 giorni alla scadenza indicata nella cella A1", vbExclamation, "ATTENZIONE"
    Case Is = Date + 9
        MsgBox "Manca 9 giorni alla scadenza indicata nella cella A1", vbExclamation, "ATTENZIONE"
End Select
End Sub

Funziona bene. Il problema è che fa riferimento a tutti i fogli indistintamente ed io avrei necessità di controllare più celle e farmi avvisare su quale foglio si trovano come potrei modificarlo? Non sono molto pratico.

 

Grazie mille

[patelModeratore patel Karma: 51 pts]

il codice che hai mostrato non fa riferimento a tutti i fogli indistintamente, ma solo al foglio attivo all'apertura del file, da quanto ho capito tu vuoi controllare più colonne di tutti i fogli e lo vuoi fare ogni volta che apri il file o soltanto quando premi un pulsante ?

Nel primo caso l'apertura potrebbe essere molto lenta. Inoltre occorre definire un range di ricerca, ricercare in tutto il foglio sarebbe troppo lungo

una prima bozza di codice potrebbe essere questa da lanciare manualmente

Sub scadenze()
For Each sh In Sheets
  For Each cell In sh.Range("L15:AB32")
    If cell = Date + 10 Then
      MsgBox "scadenza " & cell & " nel foglio " & sh.Name
    End If
  Next
Next
End Sub

 

[FROST220684Partecipante FROST220684]

Ciao Patel e grazie delle risposte.

Si sapevo che quel codice nn andava bene.

Ti riassumo quello che deve fare il vba:

1. All'apertura del file controllo solo di alcune celle (es. A43,A47,A48) di tutti i fogli presenti.

2. Il controllo deve avvenire in automatico all'apertura del file.

3. Successivamente al controllo, Excel mi dovrebbe avvisare 10 giorni prima della data inserita nelle celle controllate che quel prodotto ha 10 giorni di scadenza.

4. Questo avviso se possibile dovrebbe avvenire tramite popup che indichi la cella ed il foglio in cui è stata trovata e se ci sono più scadenza mostrare o più popup o uno unico con tutte le informazioni.

Grazie mille dell'aiuto mi facilità molto il lavoro di controllo ed io con vba purtroppo non ho molta dimistichezza

[patelModeratore patel Karma: 51 pts]

FROST220684 ha scritto:

1. All'apertura del file controllo solo di alcune celle (es. A43,A47,A48) di tutti i fogli presenti.

Allora il file allegato non è corretto

[FROST220684Partecipante FROST220684]

Scusa Patel 

Il file è giusto ma le celle a cui facevo riferimento nell'esempio erano giusto per farti capire.

Le celle per cui deve essere fatto il controllo su tutti i fogli sono:

L19 L21 L23 L25 L27 L29 L32

N19 N21 N23 N25 N27 N29 N32

P19 P21 P23 P25 P27 P29 P32

R19 R21 R23 R25 R27 R29 R32

T19 T21 T23 T25 T27 T29 T32

V19 V21 V23 V25 V27 V29 V32

X19 X21 X23 X25 X27 X29 X32

Z19 Z21 Z23 Z25 Z27 Z29 X32

AB19 AB21 AB23 AB25 AB27 AB29 AB32

.......

a me cmq basterebbe la base del codice corretto poi le celle.me le modifico io dovrei riuscire senza problemi

allego nuovamente file con le celle corrette come sopra

Grazie

 

Allegati:

You must be logged in to view attached files.

[patelModeratore patel Karma: 51 pts]

ma hai provato il codice che ti ho allegato nel post #22944 ?

[FROST220684Partecipante FROST220684]

Si ho provato ed ho inserito un pulsante a cui ho assegnato la macro.

ma non mi da nessun avviso non capisco perchè.

Ad ogni modo se possibile vorrei che fosse fatto all'apertura del foglio in automatico per limitare l'errore umano e le dimenticanze.

[albatros54Moderatore albatros54 Karma: 89 pts]

Il file di Patel(saluto) funziona. ti allego un file ,che fa quello che chiedi, si deve solo

implementare, il codice è questo

Option Explicit

Private Sub Workbook_activate()
Dim rng1 As Range, rng2 As Range, rng3 As Range
Dim Bigrng As Range
Dim sh As Worksheet
Dim cell As Object
Set rng1 = Range("L19:ab19")
Set rng2 = Range("L21:ab21")
Set rng3 = Range("L23:ab23")
Set Bigrng = Union(rng1, rng2, rng3)
For Each sh In Sheets
  For Each cell In Bigrng
    If cell = Date + 1 Then
      MsgBox "scadenza " & cell & "alla cella " & cell.Address & " nel foglio " & sh.Name
    End If
  Next
Next
End Sub

il codice va inserito nella modulo del workbook

 

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

sostituisci il codice con questo che ti posto, quando il codice trova la data supreriore al target fissato compare un messaggio che ti avvisa che ha trovato la data, nello steso tempo ti apparira un'altra Msgbox che ti chiedera se vuoi continuare la ricerca negli altri fogli,dalla tua risposta il codice continua continua la ricerca o esce .

Option Explicit

Private Sub Workbook_activate()
Dim rng1 As Range, rng2 As Range, rng3 As Range
Dim Bigrng As Range
Dim sh As Worksheet
Dim cell As Object
Set rng1 = Range("L19:ab19")
Set rng2 = Range("L21:ab21")
Set rng3 = Range("L23:ab23")
Set Bigrng = Union(rng1, rng2, rng3)
For Each sh In Sheets
  For Each cell In Bigrng
    If cell = Date + 1 Then
      MsgBox "scadenza " & cell & "alla cella " & cell.Address & " nel foglio " & sh.Name
    risposta = MsgBox(" Vuoi continuare nella ricerca?", vbYesNo)
    If risposta = vbNo Then
    Exit Sub
    End If
    End If
  Next
Next

 

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[FROST220684Partecipante FROST220684]

Ciao Albatros e grazie anche a te dell'aiuto. Il codice funziona però ci sono alcuni errori che non capisco come modificare.

Ti allego sia il file che il codice da me modificato.

1) Se ha una data in scadenza nel foglio di Gennaio, mi apre 12 popup (1 per ogni mese) vedrai da solo all'apertura del file

2) se io sono sul foglio Febbraio ed ho una data in scadenza nel foglio di Gennaio la formula non si attiva.

3)Foglio attivo Gennaio, ho 2 scadenze una sul foglio di Gennaio e l'altra sul foglio di Novembre, mi segnala solo quella di gennaio.

Questo è il codice modificato con i Range che mi servono:

Option Explicit

Private Sub Workbook_activate()
Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, rng5 As Range, rng6 As Range, rng7 As Range
Dim Bigrng As Range
Dim sh As Worksheet
Dim cell As Object
Set rng1 = Range("L19:ab19")
Set rng2 = Range("L21:ab21")
Set rng3 = Range("L23:ab23")
Set rng4 = Range("L25:ab25")
Set rng5 = Range("L27:ab27")
Set rng6 = Range("L29:ab29")
Set rng7 = Range("L32:ab32")
Set Bigrng = Union(rng1, rng2, rng3, rng4, rng5, rng6, rng7)
For Each sh In Sheets
  For Each cell In Bigrng
    If cell = Date + 1 Then
      MsgBox "scadenza " & cell & "alla cella " & cell.Address & " nel foglio " & sh.Name
    End If
  Next
Next
End Sub

Ti allego anche il file.

Grazie mille a tutti siete una risorsa inestimabile

Allegati:

You must be logged in to view attached files.

[FROST220684Partecipante FROST220684]

risposta al 22995

Option Explicit

Private Sub Workbook_activate()
Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, rng5 As Range, rng6 As Range, rng7 As Range
Dim Bigrng As Range
Dim sh As Worksheet
Dim cell As Object
Set rng1 = Range("L19:ab19")
Set rng2 = Range("L21:ab21")
Set rng3 = Range("L23:ab23")
Set rng4 = Range("L25:ab25")
Set rng5 = Range("L27:ab27")
Set rng6 = Range("L29:ab29")
Set rng7 = Range("L32:ab32")
Set Bigrng = Union(rng1, rng2, rng3, rng4, rng5, rng6, rng7)
For Each sh In Sheets
  For Each cell In Bigrng
    If cell = Date + 1 Then
      MsgBox "scadenza " & cell & "alla cella " & cell.Address & " nel foglio " & sh.Name
    risposta = MsgBox(" Vuoi continuare nella ricerca?", vbYesNo)
    If risposta = vbNo Then
    Exit Sub
    End If
    End If
  Next
Next

Mi da un errore di compilazione che non so cosa sia allego file :'''(((

 

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

Se tu vedi, nel codice c'è inserita una parolina magica "Option Explicit". Inserendo questa parolina magica, all'inizio del codice ti costringe ha dichiarare sempre le variabili, per non farti incorrere in errore, come nel tuo caso. Facendo il debug del codice ti dice che c'è un errore nella variabile "risposta"  

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[FROST220684Partecipante FROST220684]

Caro Albatros 

Mi fai i trabocchetti? hahahahah   

Senti ho modificato ma rimangono comunque due problemi come potrai vedere facendo alcune prove:

1) Ho inserito 3 Scadenze (1 Gennaio, 1 Marzo, 1 Agosto), Quando apro il file fa il controllo in modo corretto della prima cella di Gennaio quando poi clicco vuoi continuare lui mi continua a dire che la scadenza è presente nella stessa cella anche nel foglio di Febbraio e se continuo a cliccare si arriva fino a Dicembre.

2) altro problema è che non riconosce le altre scadenze lui mi da solo quella di Gennaio ma non mi comunica quella di Marzo ed Agosto. Ti allego codice e file e ti chiedo scusa per lo stress ma sto andando un po in confusione 🙂

Private Sub Workbook_activate()
Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, rng5 As Range, rng6 As Range, rng7 As Range
Dim Bigrng As Range
Dim sh As Worksheet
Dim cell As Object
Set rng1 = Range("L19:ab19")
Set rng2 = Range("L21:ab21")
Set rng3 = Range("L23:ab23")
Set rng4 = Range("L25:ab25")
Set rng5 = Range("L27:ab27")
Set rng6 = Range("L29:ab29")
Set rng7 = Range("L32:ab32")
Set Bigrng = Union(rng1, rng2, rng3, rng4, rng5, rng6, rng7)
For Each sh In Sheets
  For Each cell In Bigrng
    If cell = Date + 1 Then
      MsgBox "scadenza " & cell & "alla cella " & cell.Address & " nel foglio " & sh.Name
    risposta = MsgBox(" Vuoi continuare nella ricerca?", vbYesNo)
    If risposta = vbNo Then
    Exit Sub
    End If
    End If
  Next
Next
End Sub

 

Grazie mille

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

Sostituisci il codice con questo.

Option Explicit
Private Sub Workbook_activate()
Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, rng5 As Range, rng6 As Range, rng7 As Range
    Dim Bigrng As Range
    Dim sh As Worksheet
    Dim trova As Variant
    Dim risposta As Integer

    For Each sh In ActiveWorkbook.Worksheets
        Set rng1 = sh.Range("L19:ab19")
        Set rng2 = sh.Range("L21:ab21")
        Set rng3 = sh.Range("L23:ab23")
        Set rng4 = sh.Range("L25:ab25")
        Set rng5 = sh.Range("L27:ab27")
        Set rng6 = sh.Range("L29:ab29")
        Set rng7 = sh.Range("L32:ab32")
        Set Bigrng = Union(rng1, rng2, rng3, rng4, rng5, rng6, rng7)

        For Each trova In Bigrng


            If trova = Date + 1 Then
                MsgBox "scadenza " & trova & "alla cella " & trova.Address & " nel foglio " & sh.Name
                risposta = MsgBox(" Vuoi continuare nella ricerca?", vbYesNo)
                If risposta = vbNo Then
                    Exit Sub
                End If

            End If

        Next

    Next
End Sub

 

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[FROST220684Partecipante FROST220684]

Caro Albatros,

Sei il Top!!!!!!!!!!!!!

Funziona tutto benissimo, lato estetico ho provato ma non riesco secondo te come da allegato è possibile eliminare quei simboli $ prima della cella e sostituire Microsoft Excel con Avviso Scadenza Prodotto in testa al MsgBox?

Grazie mille a tutti per l'aiuto

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

sostituisci lariga di codice della prima Msgbox , con questa

MsgBox "scadenza " & trova & " alla cella " & trova.Address(RowAbsolute:=False, ColumnAbsolute:=False) & " nel foglio " & sh.Name, , "Avviso scadenza Prodotto"

 

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[FROST220684Partecipante FROST220684]

Ciao Albatros,

 

Niente non va allego file anche perchè avevo provato anche io a fare una cosa del genere ma non sono riuscito.

 

grazie mille

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

guarda che il tuo file funziona Benissimo.

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[FROST220684Partecipante FROST220684]

albatros non so perchè a me esce cosi sempre con i $ e sempre con in testa Microsoft Excel

Option Explicit
Private Sub Workbook_activate()
Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, rng5 As Range, rng6 As Range, rng7 As Range
    Dim Bigrng As Range
    Dim sh As Worksheet
    Dim trova As Variant
    Dim risposta As Integer

    For Each sh In ActiveWorkbook.Worksheets
        Set rng1 = sh.Range("L19:ab19")
        Set rng2 = sh.Range("L21:ab21")
        Set rng3 = sh.Range("L23:ab23")
        Set rng4 = sh.Range("L25:ab25")
        Set rng5 = sh.Range("L27:ab27")
        Set rng6 = sh.Range("L29:ab29")
        Set rng7 = sh.Range("L32:ab32")
        Set Bigrng = Union(rng1, rng2, rng3, rng4, rng5, rng6, rng7)

        For Each trova In Bigrng

            If trova = Date + 10 Then
                MsgBox "scadenza " & trova & " alla cella " & trova.Address(RowAbsolute:=False, ColumnAbsolute:=False) & " nel foglio " & sh.Name, , "Avviso scadenza Prodotto"
                risposta = MsgBox(" Vuoi continuare nella ricerca?", vbYesNo)
                If risposta = vbNo Then
                    Exit Sub
                End If

            End If

        Next

    Next
End Sub

non so perchè

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

che versione di excel hai? ti posto una jpg del tuo fiel. io ho excel 2010

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

Allegati:

You must be logged in to view attached files.

[FROST220684Partecipante FROST220684]

2013 🙂 Si in effetti è perfetta e mo perche non funziona :((((

Allegati:

You must be logged in to view attached files.

[FROST220684Partecipante FROST220684]

ahahahha risolto era la solita Option Explicit che rompeva i maroni

Private Sub Workbook_activate()
Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, rng5 As Range, rng6 As Range, rng7 As Range
    Dim Bigrng As Range
    Dim sh As Worksheet
    Dim trova As Variant
    Dim risposta As Integer

    For Each sh In ActiveWorkbook.Worksheets
        Set rng1 = sh.Range("L19:ab19")
        Set rng2 = sh.Range("L21:ab21")
        Set rng3 = sh.Range("L23:ab23")
        Set rng4 = sh.Range("L25:ab25")
        Set rng5 = sh.Range("L27:ab27")
        Set rng6 = sh.Range("L29:ab29")
        Set rng7 = sh.Range("L32:ab32")
        Set Bigrng = Union(rng1, rng2, rng3, rng4, rng5, rng6, rng7)

        For Each trova In Bigrng


            If trova = Date + 10 Then
                MsgBox "scadenza " & trova & " alla cella " & trova.Address(RowAbsolute:=False, ColumnAbsolute:=False) & " nel foglio " & sh.Name, , "Avviso scadenza Prodotto"
                risposta = MsgBox(" Vuoi continuare nella ricerca?", vbYesNo)
                If risposta = vbNo Then
                    Exit Sub
                End If

            End If

        Next

    Next
End Sub

 

grazie comunque sei fondamentale

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

quando lanci il file con le modifiche alla msgbox ti da qualche errore?prova ad andare sull'help di excel selezionando la msgbox e premendo F1, e vedere i parametri della msgbox.

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[Autore]

Articoli