Boucle avec double condition sur comparaison date et contenu
Bonjour à tous,
Je ne suis pas un habitué du VBA mais grâce à ce forum , par le passé, j'ai réussi à me "dépatouiller" avec votre aide. Merci
Dans mon programme de relance automatique via calendrier Outlook, une partie ne fonctionne pas.
Objectif : colorier la cellule si et seulement si la date est la date du jour ou antérieur.
J'ai essayé plusieurs chose mais rien y fait, voilà la partie qui ne fonctionne pas et en PJ le fichier
Merci d'avance pour vos conseils.
Xav
Option Explicit
Const cRange = "L2:L" 'Adresse du début de la plage des cellules à contrôler
Const xlDown = -4121
Sub test()
Dim oSheet As Object
Dim oRange As Object, oCell As Object
Dim lLastRow As Long, sRange As String
'On créé l'objet "EXCEL"
Set oSheet = Sheets("prospects")
lLastRow = oSheet.Range("B2").End(xlDown).Row 'Dernière cellule pleine de la colonne B
'On stocke l'adresse de la plage à parcourir dans une variable locale
sRange = cRange & CStr(lLastRow)
'On affecte la plage à parcourir
Set oRange = oSheet.Range(sRange)
'On parcourt la plage
For Each oCell In oRange.Cells
'Pour chaque cellule de la plage
'Si la cellule est vide on passe
If oCell.Offset(0, 10).Value = "" Then
End If
'Si elle n'est pas vide et si la date est inférieure ou égale à la date du jour
If oCell.Offset(0, 10).Value <= Date And oCell.Offset(0, 10) <> "" Then
'On color l'intérieur en rouge
oCell.Interior.ColorIndex = 3
End If
Next oCell
End Subbonjour Bioteau,
n'est-ce pas plus facile avec une mise en forme conditionnelle (MFC) ?
Bonjour Bart,
Merci pour ta réponse, mais comme je le disais, ce n'est qu'une partie du programme. En réalité, ce n'est pas une coloration de la cellule que je veux faire mais plusieurs actions dont l'envoi d'un rappel sur calendrier Outlook.
Pour simplifier ma demande j'ai donc isoler une partie du programme sur lequel je bloque et je me dis que si on arrive à faire une action de coloration on arrivera à faire plein d'autres choses
Je recherche une solution VBA .
Merci
re,
comme c'est un tableau structuré, on peut utiliser cela, alors c'est assez facile
Sub test2()
Dim oCell As Range, b As Boolean
For Each oCell In Range("Tableau2").ListObject.ListColumns("Rappeler le").DataBodyRange.Cells 'chaque cellule dans cette colonne de ce tableau structuré
'Si elle n'est pas vide et si la date est inférieure ou égale à la date du jour
b = (oCell.Value <= Date And oCell <> "")
'On color l'intérieur en rouge, sinon aucun couleur
oCell.Interior.ColorIndex = IIf(b, 3, 0)
Next oCell
End SubBonjour Bart,
Merci, cela fonctionne effectivement.......mais pas lorsque je l'ajoute à mon programme. A priori blocage sur la variable oCell , il n'accepte pas l'attribut Range.
Précision importante : cette macro est placée au niveau de Outlook et non Excel, c'est peut-etre la raison. voici le code complet placé dans Outlook
Option Explicit
Const cWBName = "z:\PROSPECTS CLIENTS\Prospect secteur Sud\PROSPECTS_CLIENTS PLANNING APPELS1.xlsm" 'Nom et chemin complet du classeur "PROSPECTS_CLIENTS PLANNING APPELS"
Const cRange = "P2:P" 'Adresse du début de la plage des cellules à contrôler
Const cSujet = "RAPPELER PROSPECT 'PROSPECTS_CLIENTS PLANNING APPELS'" 'Sujet du mail
Const cCorps = "Suivant le fichier 'PROSPECTS CLIENTS PLANNING APPELS', vous devez rappeler le prospect XXXXXX au TTTTTT ou au MMMMMM" 'Corps du mail
Const xlDown = -4121
******************************************************************************
Sub test()
Dim oEXCEL As Object
Dim oWB As Object
Dim oSheet As Object
Dim oRange As Object
Dim oCell As Range
'oCell As Object
Dim b As Boolean
Dim lLastRow As Long, sRange As String
Dim sTO As String, sBody As String
'On créé l'objet "EXCEL"
Set oEXCEL = CreateObject("Excel.Application")
'On ouvre le classeur "PROSPECTS_CLIENTS PLANNING APPELS.xlsm" NE PAS OUBLIER DE MODIFIER LE CHEMIN DE LA CONSTANTE EN DEBUT DE PROCEDURE
Set oWB = oEXCEL.Workbooks.Open(cWBName, , True)
'On affecte la feuille 1 du classeur à une variable-objet locale
Set oSheet = oWB.Worksheets(1)
Set oCell = oSheet.Range("Tableau2")
'pour chaque cellule dans cette colonne de ce tableau structuré nommé "Tableau2"
For Each oCell In oSheet.Range("Tableau2").ListObject.ListColumns("Rappeler le").DataBodyRange.Cells
'Si elle n'est pas vide et si la date est inférieure ou égale à la date du jour
b = (oCell.Value <= Date And oCell <> "")
'On récupère les données nécessaires pour l'envoi du mail
sTO = "" 'adresse destinataire
sBody = cCorps 'On récupère le corps du mail indiqué dans la constante présente en début de module
sBody = Replace(sBody, "XXXXXX", oCell.Offset(, -14)) 'On remplace les XXXXXX avec la référence de la ligne en colonne "B"
sBody = Replace(sBody, "TTTTTT", oCell.Offset(, -11)) 'On remplace les TTTTTT avec la référence de la ligne en colonne "E"
sBody = Replace(sBody, "MMMMMM", oCell.Offset(, -10)) 'On remplace les MMMMMM avec la référence de la ligne en colonne "F"
SendAMail sTO, cSujet, sBody 'On exécute l'envoi du mail par la procédure SendAMail
'End If
Next oCell
'On ferme le classeur sans sauvegarder les modifications
oWB.Close False
'On fait le ménage
Set oWB = Nothing
oEXCEL.Quit ' on quitte l'instance EXCEL créée
Set oEXCEL = Nothing
End Sub
Sub SendAMail(zTO As String, zSubject As String, zBody As String)
Dim oEmail As MailItem
'On créé un nouveau mail
Set oEmail = Application.CreateItem(olMailItem)
With oEmail
'On affecte les destinataires
.To = zTO
'On affecte une importance haute ----- La ligne peut être supprimée si non nécessaire
.Importance = olImportanceHigh
'On affecte l'objet du mail avec la variable passée en paramètre de cette procédure
.Subject = zSubject
'On affecte le corps du mail avec la variable passée en paramètre de cette procédure
.Body = zBody
'On envoi le mail
.Send
End With
'On fait le ménage
Set oEmail = Nothing
End Subre,
sorry, je n'ai jamais utilisé VBA à partir de "Outlook", donc je n'ai pas d'experience, mais je suppose qu'avec un tableau structuré ceci suffit, on n'a pas besoin du nom de la feuille. J'éspère que le nom du tableau est encore "Tableau2", non ?
...
Set oWB = oEXCEL.Workbooks.Open(cWBName, , True)
'pour chaque cellule dans cette colonne de ce tableau structuré nommé "Tableau2"
For Each oCell In oWB.Range("Tableau2").ListObject.ListColumns("Rappeler le").DataBodyRange.Cells
...Re bonjour Bart,
J'ai finalement réussi à trouver la solution. J'ai adapté la formule de la mise en forme conditionnelle en VBA.
Je joints le code complet si cela peut servir à d'autre. L'objectif étant à partir d'un fichier EXCEL de créer une alerte de relance via Outlook.
Je te remercie de ton temps passé, sans toi je n'aurai pas trouvé la solution. Je tiens à remercier également GVIALLES pour son code "mère".https://forum.excel-pratique.com/excel/envoi-automatique-d-une-alerte-par-mail-155585.
Option Explicit
Const cWBName = "c:\Classeur1.xlsm" 'Nom et chemin complet du classeur à adapter
Const cRange = "L2:L" 'Adresse du début de la plage des cellules à contrôler
Const cSujet = "RAPPELER PROSPECT 'PROSPECTS_CLIENTS PLANNING APPELS'" 'Sujet du mail
Const cCorps = "Suivant le fichier 'PROSPECTS CLIENTS PLANNING APPELS', vous devez rappeler le prospect XXXXXX au TTTTTT ou au MMMMMM" 'Corps du mail
Const xlDown = -4121
*********************************************************************
Sub RelanceProspects()
Dim oEXCEL As Object
Dim oWB As Object
Dim oSheet As Object
Dim oRange As Object
Dim oCell As Object
Dim lLastRow As Long, sRange As String
Dim sTO As String, sBody As String
'On créé l'objet "EXCEL"
Set oEXCEL = CreateObject("Excel.Application")
'On ouvre le classeur "Classeur1" NE PAS OUBLIER DE MODIFIER LE CHEMIN DE LA CONSTANTE EN DEBUT DE PROCEDURE
Set oWB = oEXCEL.Workbooks.Open(cWBName, , True)
'On affecte la feuille 1 du classeur à une variable-objet locale
Set oSheet = oWB.Worksheets(1)
Set oCell = oSheet.Range("Tableau2")
lLastRow = oSheet.Range("B2").End(xlDown).Row 'Dernière cellule pleine de la colonne B
'On stocke l'adresse de la plage à parcourir dans une variable locale
sRange = cRange & CStr(lLastRow)
'On affecte la plage à parcourir
Set oRange = oSheet.Range(sRange)
For Each oCell In oRange.Cells 'Pour chaque cellule de la plage
'Si la date contenue dans la cellule est inférieure ou égale à la date du jour - 7
If oCell.Value <> "" And oCell.Value <= Now() Then
'On récupère les données nécessaires pour l'envoi du mail
sTO = oCell.Offset(,-5).value 'On va chercher le mail pour l'adresse mail destinataire
sBody = cCorps 'On récupère le corps du mail indiqué dans la constante présente en début de module
sBody = Replace(sBody, "XXXXXX", oCell.Offset(, -10)) 'On remplace les XXXXXX avec la référence de la ligne en colonne "B"
sBody = Replace(sBody, "TTTTTT", oCell.Offset(, -7)) 'On remplace les TTTTTT avec la référence de la ligne en colonne "E" (numéro tél.)
sBody = Replace(sBody, "MMMMMM", oCell.Offset(, -6)) 'On remplace les MMMMMM avec la référence de la ligne en colonne "F" (numéro mob.)
SendAMail sTO, cSujet, sBody 'On exécute l'envoi du mail par la procédure SendAMail
End If
Next oCell
'On ferme le classeur sans sauvegarder les modifications
oWB.Close False
'On fait le ménage
Set oWB = Nothing
oEXCEL.Quit ' on quitte l'instance EXCEL créée
Set oEXCEL = Nothing
End Sub
*********************************************************************
Sub SendAMail(zTO As String, zSubject As String, zBody As String)
Dim oEmail As MailItem
'On créé un nouveau mail
Set oEmail = Application.CreateItem(olMailItem)
With oEmail
'On affecte les destinataires
.To = zTO
'On affecte une importance haute ----- La ligne peut être supprimée si non nécessaire
.Importance = olImportanceHigh
'On affecte l'objet du mail avec la variable passée en paramètre de cette procédure
.Subject = zSubject
'On affecte le corps du mail avec la variable passée en paramètre de cette procédure
.Body = zBody
'On envoi le mail
.Send
End With
'On fait le ménage
Set oEmail = Nothing
End Sub