• Initiateur de la discussion Initiateur de la discussion fred777
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

fred777

XLDnaute Junior
Bonjour le forum,

J'ai une base de donnée qui contient en colonne AY des dates de fin de contrat. A l'ouverture, je voudrai une alerte pour toutes les lignes dont le contrat arrive à échéance le mois courant.

Voici mon code

Private Sub Workbook_Open()
'Définition des variables :
Dim ColDossier As String, ColDate As String
'Affectation des variables
ColDossier = "A"
ColDate = "AY"
'Départ de la boucle à la dernière cellule de la feuille
ActiveCell.SpecialCells(xlLastCell).Select
Cells(ActiveCell.Row, ColDate).Select
Selection.End(xlUp).Select
'Début Boucle :
Do While ActiveCell.Row > 1 'pas d'action sur les lignes 1 à 1
If ActiveCell.Value > 1 And ActiveCell.Value < Date + 15 Then 'controle valeur de date
MsgBox "Attention contrat " & _
IIf(Cells(ActiveCell.Row, ColDossier).Value = "", _
Cells(ActiveCell.Row, ColDossier).End(xlUp).Value, _
Cells(ActiveCell.Row, ColDossier).Value) & _
" à renouveler !" 'affiche le message
End If
ActiveCell.Offset(-1, 0).Select 'passe une ligne
Loop
'Fin Boucle.
End Sub

Le code fonctionne pour les contrats qui sont arrivés à échéance depuis + de 15 jours, mais ce que je souhaite ce sont les contrats qui sont à échéance le mois en cours (entre le 1er du mois et le 30 ou 31). Exemple si aujourd'hui le 22/10/2014, je souhaite être alerté sur toutes les échéances d'octobre. Je n'arrive pas à adapter ce code.

Merci d'avance.
 
Re : Alerte Date du mois

Bonjour à tous

EDITION: Bonjour Paf 😉

Vois ce que t'inspire ce petit exemple
(à tester sur un classeur vierge)
Code:
Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 22/10/2014 par Staple en extérieur
'

Range("A1") = Date
Range("A1").AutoFill Destination:=Range("A1:A15"), Type:=xlFillWeekdays
  For Each c In Range("A1:A15")
  If Month(c) = Month(Date) Then
  MsgBox c
  Else
  MsgBox c & Chr(13) & "Date en dehors du mois en cours"
  End If
Next
End Sub
 
Dernière édition:
Re : Alerte Date du mois

Bonjour à tous

connaissant les premier et dernier jours du mois en cours, il 'suffit' d'adapter le test.
Code:
DerJourMois = DateSerial(Year(Date), Month(Date) + 1, 0)
PremJourMois = DateSerial(Year(Date), Month(Date), 1)

A+

Edit : Bonjour Staple, ... c'était bien plus simple !!
 
Dernière édition:
Re : Alerte Date du mois

Bonjour à tous

connaissant les premier et dernier jours du mois en cours, il 'suffit' d'adapter le test.
Code:
DerJourMois = DateSerial(Year(Date), Month(Date) + 1, 0)
PremJourMois = DateSerial(Year(Date), Month(Date), 1)

A+

Edit : Bonjour Staple, ... c'était bien plus simple !!

Merci Staple et Paf.

J'ai adapté le code de Paf et ça a l'air de fonctionner. Juste une chose. L'alerte s'ouvre sur chaque ligne trouvées. est-il possible d'avoir un seul msgbox reprenant la liste complète ?

Merci à vous
 
Re : Alerte Date du mois

Re

l'adaptation de ce qu'a proposé Staple aurait pu être:

Code:
If ActiveCell.Value > 1 And Month(ActiveCell.Value) = Month(Date) .........


pour l'affichage unique, cumuler les alertes dans une variable dans la boucle et afficher le message en sortie de boucle.

Du style :

début de boucle
if xx .... then ....
MonMessage=MonMessage & _
"Attention contrat " & _
IIf(Cells(ActiveCell.Row, ColDossier).Value = "", _
Cells(ActiveCell.Row, ColDossier).End(xlUp).Value, _
Cells(ActiveCell.Row, ColDossier).Value) & _
" à renouveler !" & Chr(13)
end if
fin de boucle

msgbox MonMessage


A+
 
Re : Alerte Date du mois

Re

Voici le précédent code adapté pour un seul MsgBox
Code:
Sub Macro2()
'
' Macro enregistrée le 22/10/2014 par Staple en extérieur
'
Dim Mess$, c As Range
Range("A1") = Date
Range("A1").AutoFill Destination:=Range("A1:A15"), Type:=xlFillWeekdays
  For Each c In Range("A1:A15")
  If Month(c) = Month(Date) Then
  Mess = Mess & Chr(13) & c.Address(0, 0) & ": " & c
  Else
  '
  End If
Next
MsgBox Mess, vbCritical, "Dates du mois en cours"
End Sub

NB: Si on ne veut que les dates du mois et de l'année en cours, utiliser ceci:
If Month(c) = Month(Date) And Year(c) = Year(Date) Then
 
Dernière édition:
Re : Alerte Date du mois

Bonjour à vous 2 et au forum,

Voici l'adaptation de mon code avec vos précieux conseils.

Private Sub Workbook_Open()
'Définition des variables :
Dim ColDossier As String, ColDate As String
'Affectation des variables
ColDossier = "A"
ColDate = "AY"
'Départ de la boucle à la dernière cellule de la feuille
ActiveCell.SpecialCells(xlLastCell).Select
Cells(ActiveCell.Row, ColDate).Select
Selection.End(xlUp).Select
'Début Boucle :
Do While ActiveCell.Row > 1 'pas d'action sur les lignes 1 à 1
If ActiveCell.Value > DateSerial(Year(Date), Month(Date), 1) And ActiveCell.Value < DateSerial(Year(Date), Month(Date) + 2, 0) Then 'controle valeur de date
MsgBox "Attention contrat " & _
IIf(Cells(ActiveCell.Row, ColDossier).Value = "", _
Cells(ActiveCell.Row, ColDossier).End(xlUp).Value, _
Cells(ActiveCell.Row, ColDossier).Value) & _
" à renouveler !" 'affiche le message
End If
ActiveCell.Offset(-1, 0).Select 'passe une ligne
Loop
'Fin Boucle.
End Sub


Cela fonctionne bien et je vous remercie tous les 2. En revanche, je ne parviens pas à adapter le code pour qu'il m'affiche tous les résultats dans un seul MsgBox.

Par ailleurs, je ne comprends pas le code de Staple ci-dessous et ne parviens pas à l'adapter :

Sub Macro2()
'
' Macro enregistrée le 22/10/2014 par Staple en extérieur
'
Dim Mess$, c As Range
Range("A1") = Date
Range("A1").AutoFill Destination:=Range("A1:A15"), Type:=xlFillWeekdays
For Each c In Range("A1:A15")
If Month(c) = Month(Date) Then
Mess = Mess & Chr(13) & c.Address(0, 0) & ": " & c
Else
'
End If
Next
MsgBox Mess, vbCritical, "Dates du mois en cours"
End Sub


Notamment concernant les Range. Mes dates de fin de contrat se trouvent en colonne "AY" et le nom des salariés concernés en colonne "A".

Je suis un peu novice en vba et j'apprends sur le tas, notamment sur des forums comme celui-ci. Merci de votre compréhension et pour vos excellents conseils.
 
Re : Alerte Date du mois

Re

concernant le message, Staple a fourni un exemple à adapter. Tel quel, il y a peu de chance que ça fonctionne sur votre classeur.

il faut intégrer la construction du message dans la boucle .voir mon post #5

vous y êtes presque.

A+
 
Re : Alerte Date du mois

Re

En fait j'avais une erreur "Erreur de compilation - variable non définie". J'ai donc déclarer la variable MonMessage avec Dim mais sans précisé de type. Dois-je déclarer un type ? Sans type ça a l'air de fonctionner. Voici le code :

Private Sub Workbook_Open()
'Définition des variables :
Dim ColDossier As String, ColDate As String
Dim MonMessage
'Affectation des variables
ColDossier = "A"
ColDate = "AY"
'Départ de la boucle à la dernière cellule de la feuille
ActiveCell.SpecialCells(xlLastCell).Select
Cells(ActiveCell.Row, ColDate).Select
Selection.End(xlUp).Select
'Début Boucle :
Do While ActiveCell.Row > 1 'pas d'action sur les lignes 1 à 1
If ActiveCell.Value > DateSerial(Year(Date), Month(Date), 1) And ActiveCell.Value < DateSerial(Year(Date), Month(Date) + 2, 0) Then 'controle valeur de date
MonMessage = MonMessage & _
"Attention contrat " & _
IIf(Cells(ActiveCell.Row, ColDossier).Value = "", _
Cells(ActiveCell.Row, ColDossier).End(xlUp).Value, _
Cells(ActiveCell.Row, ColDossier).Value) & _
" à renouveler !" & Chr(13) 'affiche le message
End If
ActiveCell.Offset(-1, 0).Select 'passe une ligne
Loop
'Fin Boucle.
MsgBox MonMessage
End Sub

Merci encore
 
Re : Alerte Date du mois

re,

pour les déclarations de variables, se reporter à l'aide.

en gros Dim sans type est un fourre tout qui acceptera n'importe quel type de donnée. le fait de préciser le type optimise la place occupée en mémoire. Ici il faudrait Dim MonMessage as String

Affaire résolue?
 
Re : Alerte Date du mois

Re Paf,

J'ai voulu modifier le code pour que le message d'alerte me dise "Attention contrat UNTEL à renouveler le [date de renouvellement]" comme cela :

Sub Macro111()
'Définition des variables :
Dim ColDossier As String, ColDate As String
Dim MonMessage As String
'Affectation des variables
ColDossier = "A"
ColDate = "AY"
'Départ de la boucle à la dernière cellule de la feuille
ActiveCell.SpecialCells(xlLastCell).Select
Cells(ActiveCell.Row, ColDate).Select
Selection.End(xlUp).Select
'Début Boucle :
Do While ActiveCell.Row > 1 'pas d'action sur les lignes 1 à 1
If ActiveCell.Value > DateSerial(Year(Date), Month(Date), 1) And ActiveCell.Value < DateSerial(Year(Date), Month(Date) + 2, 0) Then 'controle valeur de date
MonMessage = MonMessage & _
"Attention contrat " & _
IIf(Cells(ActiveCell.Row, ColDossier).Value = "", _
Cells(ActiveCell.Row, ColDossier).End(xlUp).Value, _
Cells(ActiveCell.Row, ColDossier).Value) & _
" à renouveler le " & _
Cells(ActiveCell.Row, ColDate).Value & _
" ! " & Chr(13) 'affiche le message
End If
ActiveCell.Offset(-1, 0).Select 'passe une ligne
Loop
'Fin Boucle.
MsgBox MonMessage
End Sub


Le problème c'est que cela ne marche mais qu'à moitié 🙁

En effet il me donne bien la liste mais celle-ci est tronquée à savoir qu'il s'arrête avant la fin de la liste et au milieu du message. Par exemple au lieu de me donner la liste complète des 23 contrats à renouveler, il ne m'en donne que 21 et encore le 21ème ne me donne pas le date de renouvellement. Je ne comprend pas .
 
Re : Alerte Date du mois

Bonsoir à tous EDITION: Bonsoir Paf

fred777
Dans mon exemple, j'avais déclaré en string 😉 : Dim Mess$
Certes d'une façon raccourcie avec le $
$ qui justement aurait du t'interpeller
Ce qui ne fut pas le cas 😉
Est-ce qu'alors cela voudrait dire que tu copies/colles les codes VBA sans chercher à comprendre leur syntaxe ? 😉


Pour le reste une MsgBox ne peut contenir qu'un nombre limité de caractères.
Voir l'aide VBA ou Ce lien n'existe plus
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
245
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
174
Réponses
2
Affichages
462
Réponses
2
Affichages
514
Réponses
8
Affichages
479
Réponses
12
Affichages
501
Réponses
2
Affichages
501
Retour