Erreur de type 13.. Encore
je m'excuse, je ne suis aps très clair. En cherchant pourquoi les messagesbox affichaient tous les noms, j'ai remarqué que chaque ligne de code ladate = w1.Range("AF" & I) affichait cette erreur.
En principe,
p = D (date du jour) - ladate (définie par la cellule)
If p >= 0 Then
Or, en dépit de ladate, p est toujours considéré comme >=0
Oui c'est un code plutôt "crade"
Je t'ai dit (plu haut) de modifier la formule de date
1. modifier la formule en L3 mettre :
=SI(Effectif!$D3>0;DATE(ANNEE(Effectif!$D3);MOIS(Effectif!$D3);JOUR(Effectif!$D3));"")
et tirer la formule vers le bas.
Ça n'empêchera pas le code de tout ramener mais au moins tu auras de véritables dates et pas seulement des cellules qui ont l'apparence de date mais qui en fait sont des strings.
Pour le reste mon conseil est de virer toutes ces macros et de remplacer par un format conditionnel comme dans le fichier joint, ça te sera surement plus utile que le joli dégradé arc en ciel mais qui ne sert à rien
A+
@Galopin01
Sauf erreur de ma part notre ami a du parler quelque part de quelques centaines de ligne...
Peut-être
Perso, je développe toujours avec la logique des choses
@Theyoshi,
Voici ton code modifié comme il ce doit
Option Explicit
Sub Alertes()
'
' Alerte Macro
'
Dim D As Date
Dim Lig As Long
Dim sDate As String, LaDate As Date
Dim P As Long
Dim ListeBus As String
Dim ListeCMU As String
Dim ListeFinatJM As String
Dim ListeTravail As String
Dim ListeRegularisation As String
Dim Rep As Integer
Dim w1 As Worksheet
Set w1 = Worksheets("Effectif") 'Feuille qui contient les alertes
D = Date
' ********************************* fin de BUS
For Lig = 3 To w1.Range("AF" & Rows.Count).End(xlUp).Row
Select Case w1.Cells(Lig, "AF").Value
Case "Néant"
'ici le code prévu à cet effet ou rien
Case Else
sDate = w1.Range("AF" & Lig)
If IsDate(sDate) Then
LaDate = DateValue(sDate)
P = D - LaDate
If P >= 0 Then ListeBus = ListeBus & vbLf & "L'abonnement de bus pour " & Cells(Lig, "C").Value & " a expiré depuis le " & Cells(Lig, "AF")
End If
End Select
Next Lig
' ********************************* fin de CMU
For Lig = 3 To w1.Range("AB" & Rows.Count).End(xlUp).Row
sDate = w1.Range("AB" & Lig)
If IsDate(sDate) Then
LaDate = DateValue(sDate)
P = D - LaDate
If P >= 0 Then ListeCMU = ListeCMU & vbLf & "La CMU pour " & Cells(Lig, "C").Value & " est expirée depuis le " & Cells(Lig, "AB")
If P > -30 And P < 0 Then ListeCMU = ListeCMU & vbLf & "La CMU pour " & Cells(Lig, "C").Value & " expirera le " & Cells(Lig, "AB").Value
End If
Next Lig
' ********************************* fin d'ATJM
For Lig = 3 To w1.Range("V" & Rows.Count).End(xlUp).Row
sDate = w1.Range("V" & Lig)
If IsDate(sDate) Then
LaDate = DateValue(sDate)
P = D - LaDate
If P >= 0 Then ListeFinatJM = ListeFinatJM & vbLf & "L'ATJM pour " & Cells(Lig, "C").Value & " est expirée depuis le " & Cells(Lig, "V").Value
If P > -60 And P < 0 Then ListeFinatJM = ListeFinatJM & vbLf & "L'ATJM pour " & Cells(Lig, "C").Value & " expirera le " & Cells(Lig, "V").Value
End If
Next Lig
' ********************************* Regularisation
For Lig = 3 To w1.Range("L" & Rows.Count).End(xlUp).Row
sDate = w1.Range("L" & Lig)
If IsDate(sDate) Then
LaDate = DateValue(sDate)
P = D - LaDate
If P >= 0 Then ListeRegularisation = ListeRegularisation & vbLf & "La demande de titre de séjour pour " & Cells(Lig, "C").Value & " devrait être envoyée depuis depuis le " & Cells(Lig, "V").Value
If P > -60 And P < 0 Then ListeRegularisation = ListeRegularisation & vbLf & "La demande de titre de séjour pour " & Cells(Lig, "C").Value & " devra être envoyée avant le " & Cells(Lig, "V").Value
End If
Next Lig
' ********************************* Fin d'autorisation de travail
For Lig = 3 To w1.Range("AU" & Rows.Count).End(xlUp).Row
sDate = w1.Range("AU" & Lig)
If IsDate(sDate) Then
LaDate = DateValue(sDate)
P = D - LaDate
If P >= 0 Then ListeTravail = ListeTravail & vbLf & "L'autorisation de travail pour " & Cells(Lig, "C").Value & " est expirée depuis le " & Cells(Lig, "AU").Value
If P > -60 And P < 0 Then ListeTravail = ListeTravail & vbLf & "L'autorisation de travail pour " & Cells(Lig, "C").Value & " expirera le " & Cells(Lig, "AU").Value
End If
Next Lig
Rep = MsgBox(ListeCMU, vbExclamation + vbOKCancel, "Mise à jour des CMU demandée")
If Rep = vbCancel Then Exit Sub
Rep = MsgBox(ListeBus, vbExclamation + vbOKCancel, "Abonnements de bus perimés")
If Rep = vbCancel Then Exit Sub
Rep = MsgBox(ListeFinatJM, vbExclamation + vbOKCancel, "ATJM à renouveler")
If Rep = vbCancel Then Exit Sub
Rep = MsgBox(ListeRegularisation, vbExclamation + vbOKCancel, "Demande titre de séjour à faire")
Rep = MsgBox(ListeTravail, vbExclamation + vbOKCancel, "Autorisations de travail à renouveler")
If Rep = vbCancel Then Exit Sub
'
End Sub@+
Nous n'avons pas les mêmes valeurs mon ami !
@Galopin01
Avec plus de 6.000 messages c'est bien dommage, mais ce ne doit pas être ton métier
Bonjour
Reprise du boulot et donc du fichier. je vous remercie de votre aide. Cela m'a beaucoup permis de progresser.
Il y a encore des améliorations à apporter mais je vais tenter d'y remédier.