Alerte échéance par msgbox

[fun_guilhem]

Bonjour à tous,


j'ai une question qui réclame votre aide.
Pourriez-vous me dire comment faire pour qu'une message box s'affiche à l'ouverture de mon fichier dès que j'ai dépassé une échéance.

Tout est dit dans le fichier joint.

Merci par avance.

Guilhem

 

[ROGER2327]

Re : Alerte échéance par msgbox

Bonjour fun_guilhem

Un essai, à placer dans le module ThisWorkbook.

[COLOR="DarkSlateGray"]Private Sub Workbook_Open()
Dim oDat, i As Long
   With ThisWorkbook.Sheets(1)
      .Calculate
      oDat = .Range(.Cells(1, 6), .Cells(.Rows.Count, 6).End(xlUp)).Value
      For i = 2 To UBound(oDat, 1)
         If oDat(i, 1) = "Envoyer questionnaire" Then Exit For
      Next i
      If i <= UBound(oDat, 1) Then MsgBox "Alerte"
   End With
End Sub[/COLOR]

ROGER2327

Premier Vendémiaire CCXVIII
Bonne année !​

 

[Robert]

Re : Alerte échéance par msgbox

Bonjour Guilhem, bonjour le forum,

Une proposition en pièce jointe. le code est dans le composant ThisWorkbook.

Édition :

Bonjour très cher Roger. Nous nous sommes croisés.

 

[fun_guilhem]

Re : Alerte échéance par msgbox

Merci pour ces réponses. Ca m'a l'air top, sauf que j'ai toujours un problème.

J'ai essayé d'aapter votre code à mon fichier original et il me met une anomalie au niveau de la ligne surlignée:

Private Sub Workbook_Open() 'à l'ouverture du classseur
Dim pl As Range 'déclare la variaable pl
With Sheets("Feuil1") 'prend en compte l'onglet "Feuil1"
.Select 'sélectionne
Set pl = .Range("U2:U" & .Range("U65536").End(xlUp).Row) 'définit la variable pl
End With 'fin de la prise en compte de l'onglet "Feuil1"
For Each cel In pl 'boucle sur toutes les cellule éditées cel de plage pl
If CDate(cel.Value) + 30 > Date Then 'condition : si la date + 30 jours de la cellule cel est supérieure à la date du jour
MsgBox "Envoyer questionnaire à " & cel.Offset(0, -4) & " " & cel.Offset(0, -3) & " !" 'message
Range(cel.Offset(0, -4), cel.Offset(0, 1)).Interior.ColorIndex = 3 'colore la ligne
End If 'fin de la condition
Next cel 'prochaine cellule cel de la plage pl
End Sub


Pourriez-vous m'indiquer pourquoi?
Pour simplifier je vous ai envoyé le masque original de mon fichier

Merci par avance

 

[Robert]

Re : Alerte échéance par msgbox

Bonjour le fil, bonjour le forum,

J'ai du mal à comprendre pourquoi beaucoup de gens qui demandent de l'aide n'envoient pas directement un fichier basé sur leur exemple ! Quelle perte de temps...

En pièce jointe la version 2 modifiée.
En rouge les modifications du code :

Private Sub Workbook_Open() 'à l'ouverture du classseur
Dim pl As Range 'déclare la variaable pl
 
With Sheets("Feuil1") 'prend en compte l'onglet "Feuil1"
    .Select 'sélectionne
    Set pl = .Range("[COLOR=red]U5:U[/COLOR]" & .Range("[COLOR=red]U[/COLOR]65536").End(xlUp).Row) 'définit la variable pl
End With 'fin de la prise en compte de l'onglet "Feuil1"
For Each cel In pl 'boucle sur toutes les cellule éditées cel de plage pl
    If CDate(cel.Value) + 30 > Date Then 'condition : si la date + 30 jours de la cellule cel est supérieure à la date du jour
        MsgBox "Envoyer questionnaire à " & cel.Offset(0, [COLOR=red]-16[/COLOR]) & " " & cel.Offset(0, [COLOR=red]-15[/COLOR]) & " !" 'message
        Range(cel.Offset(0, [COLOR=red]-20[/COLOR]), cel.Offset(0, [COLOR=red]2[/COLOR])).Interior.ColorIndex = 3 'colore la ligne
    End If 'fin de la condition
Next cel 'prochaine cellule cel de la plage pl
End Sub

Et en bonus une explication...
Le code tel qu'il était demandait la convertion en date d'une cellule qui ne contenait pas de date et cela provoquait un bug. D'ailleurs si tu tapes un valeur non convertible en date dans la colonne U tu auras le même bug...

Édition :

Ooops j'avais oublié la pièce jointe...

 

[fun_guilhem]

Re : Alerte échéance par msgbox

Merci pour cette réponse.

Effectivement, il est plus pertinent d'envoyer son fichier original dès le début. Je me disais qu'envoyer une pâle adaptation ne changerait pas grand chose, mais en fait non...
Je le saurai pour les prochaines fois. 🙂

Merci encore.

Cordialement,

Guilhem