Macro VBA

bonsoir tous les membres ,

description de probléme

j'ai crée un code VBA dont leur but est de faire clignoter les cellules DXXX de la feuille de suivi

je suis maintenant dans le cas que chaque changement de la date d'intervention "feuille d'enregistrement" les cellules clignotent or je vais que ce clignotement déclenche si et seulement si les cellules EXXXXXX "feuille de suivi" contient "attention date ,depassée"

(exemple si E5 contient attention date dépassée" alors D5 clignote en rouge si non pas de clignotement ) et de méme pour tous autres cellules. merci pour votre aide

le code existe sous la feuille d'enregistrement

Private Sub Worksheet_Change(ByVal Target As Range)
If Me.Cells(3, Target.Column).Value = "date d'intervention" Then
  If (Target.Value <> "") And (Target.Offset(0, 1) <> "") Then
    Col = CByte(Replace(Target.Offset(-2, -2), "Element ", ""))
    Clignote Feuil1.Range("D" & Col + 4)
  End If
End If
End Sub

Bonjour,

ci-dessous code feuille

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim commentaire As Object, clignotants As Range

    If Me.Cells(3, Target.Column).Value = "date d'intervention" Then
        If (Target.Value <> "") And (Target.Offset(0, 1) <> "") Then
            With Feuil1
                For Each commentaire In .Columns("E").SpecialCells(xlCellTypeFormulas)
                    If commentaire.Value Like "*date dépassée*" Then
                        If clignotants Is Nothing Then
                            Set clignotants = Columns("D").Rows(commentaire.Row)
                        Else
                            Set clignotants = Union(clignotants, Columns("D").Rows(commentaire.Row))
                        End If
                    End If
                Next commentaire
                .Select
                If Not clignotants Is Nothing Then Clignote (clignotants.Address)
            End With
        End If
    End If
End Sub

ci-dessous code module

Sub Clignote(cel_address As String)
    Dim cel As Range, i As Integer

    Set cel = Range(cel_address)
    Do Until i = 40
      cel.Interior.ColorIndex = 3
      Minuterie
      cel.Interior.ColorIndex = 0
      Minuterie
      i = i + 1
    Loop

'remets à automatique une fois fini
cel.Interior.ColorIndex = 0

End Sub

bonsoir thev merci de me répondre exactement par fait bien solution accepté

si possible j'ai une autre probléme dans meme fichier ,j'ai crée un code dont leur but d'envoyer automatique un mail avant quelques jours de la date prochaine de chaque élement et pour éviter les conflits j'ai lié le declenchement d'envoi par un seul declencheur pour tous les éléments qu'est "lapparition de alerte suivant " attention ,date depassée" dans la feuille de suivi cellules EXXXXX et ce apparition est automatique à partir d'un formule que deja crée, donc le probléme maintenant pour ce code ce que le procedure d'envoi effectué chaque changement de date d'intervention feuille d'enregistrement et aussi chaque changement je suis obligé d'executer le code pour m'envoyer les mails et ça c'est pas bon pour mon cas ,or je vais que l'envoi des mails sera effectué d'une façon automatique chaque fois les cellules EXXXX feuille de suivi contient "attention , date dépassée "

exemple ' si (E5 contient "attention date, depassée alors le contenu de F5 sera envoyé automatiquement par mail) toujours dans le feuille de suivi ; merci de m'm'envoyer une solution pour cette probléme

code

Sub Mail_small_Text_Outlook()
    'Working in Office 2000-2010
    Dim messagerie As Object
    Dim email As Object
     Dim i As Integer            '--- n° de ligne
    i = 5
    Set messagerie = CreateObject("Outlook.Application")
    Set email = messagerie.CreateItem(0)
    'on fait la boucle en imaginant que colonne D est toujours remplie
   MsgBox "procédure d'envoi"

    strBody = ""
    For ligne = 5 To Cells(65000, "F").End(xlUp).Row
        If Cells(i, "E").Value = "Attention, date dépassée!" Then
            strBody = strBody & "description : " & Cells(i, "F").Value & vbCrLf
        End If
        i = i + 1
    Next

    With email
        .To = "nom_prénom@contoso.com"
        .Subject = "Avertissement sur Tâche"
        .Body = strBody
       .Send

            End With
            Set email = Nothing
        Set messagerie = Nothing

End Sub

Bonsoir,

Pour répondre à votre souci, j'ai créé un événement personnalisé de dépassement de date qui se déclenche à l'ouverture du fichier s'il existe une date dépassée . Cet événement est défini dans un module de classe "Dates".

Par ailleurs, afin de ne pas envoyer 2 fois le même mail, j'ai ajouté un commentaire dans les cellules concernées.

1- ajout du code nécessaire dans ThisWorkBook

Public WithEvents Dates_i As Dates  'événements du module de classe Dates

Private Sub Workbook_Open()
    Set Dates_i = New Dates         'création instance du module de classe Dates et activation de ses événements
     Dates_i.Vérif_dépassement       'vérification du dépassement d'une date
End Sub

Private Sub Dates_i_Dépassement()   'événement de dépassement d'une date
     Call Mail_small_Text_Outlook    'envoi mail
End Sub

2-modification du code de votre module "Mail_small_Text_Outlook" pour intégrer le commentaire de l'envoi du mail

    For ligne = 5 To Cells(65000, "F").End(xlUp).Row
        If Cells(i, "E").VALUE = "Attention, date dépassée!" _
        And Cells(i, "E").Comment Is Nothing Then
            strBody = strBody & "description : " & Cells(i, "F").VALUE & vbCrLf
            Cells(i, "E").AddComment.Text "envoi mail du " & Date
        End If
        i = i + 1
    Next

ci-joint fichier

bonsoir thev merci de me repondre mais lorsque j'ouvre le fichier directement il m'affiche un erreur de compilation "projet ou bibliothèque introuvable " et j'ai verfié les references j'ai trouvé ça

manquant :microsoft outlook tu vois

qu'est ce que je vais faire alors pour ressoudre ce probleme

Bonsoir,

Essayer de décocher les références manquantes.

Sinon

Vous ne devez pas avoir la même version d'Excel que la mienne. Dans ce cas, le plus simple est au niveau de votre fichier :

1- d'importer dans l'éditeur VBA le module de classe "Dates" ci-joint (lien = https://www.cjoint.com/c/GHuvzztwCMT)

2- d'appliquer les modifications de code indiquées ci-dessus.

bonsoir thev bon j'ai dechoché les references se fonctionne mais toujours meme probléme l'envoi effectué sauf aprés avoir l'exécution du code si non pas de mail

moi comme je vous declaré je vais le mail sera envoyé si et seulement si le terme "attention ,date depassée" apparaitre dans les cellules Exxx feuille de suivi

exemple E5 contient "attention ,date depassée " alors le contenu F5 sera envoyé automatiquement sans retour à l'execution du code voila merci de m'envoyer une solution

Bonjour,

Par ailleurs, afin de ne pas envoyer 2 fois le même mail, j'ai ajouté un commentaire dans les cellules concernées.

Le mail est envoyé à l'ouverture du fichier si et seulement si le terme "attention ,date depassée" apparaitre dans les cellules Exxx feuille de suivi et si elles ne sont pas annotées d'un commentaire "Envoi mail du ".

Si vous voulez envoyer le mail une 2ème fois, il faut effacer cette annotation.

Maintenant si vous voulez envoyer un mail à chaque ouverture de fichier dès que le terme "attention ,date depassée" apparaitra dans les cellules Exxx feuille de suivi , voici une version qui le fera

bonsoir thev merci de me repondre et désolé pour le retard je vois ton réponse maintenant

bon tjours méme probleme oui c'est vrai que à l'ouverture de fichier le procedure d'envoi sera effectué et sauf que "attention date depassée " present dans Exxxxx ça c 'est bon mais est ce que possible meme si le ficheir reste toujours ouvert le mail declenche automatiquement si "attention date depassée" présent dans Exxx et sans retour à l'exécution du code parce que trés probable que le fichier reste ouvert toujours et comme vous savez le développeur toujours pense aux autres qu ils utilisent cette application ,et merci de m'envoyer une solution sachant que celle ci est la meilleure qu'ai j'ai reçu jusqu’à maintenant

Bonjour,

Le plus simple me parait de programmer la fermeture automatique du fichier à une heure donnée. Ci-dessous modification du code de ThisWorkbook avec fermeture automatique à 18h

Public WithEvents Dates_i As Dates  'événements du module de classe Dates

Private Sub Workbook_Open()
    Set Dates_i = New Dates         'création d'une instance du module de classe Dates et activation des événements
     Dates_i.Vérif_dépassement       'vérification du dépassement d'une date
     Application.OnTime TimeValue("18:00:00"), "ThisWorkbook.Fermeture"   'fermeture à 18h
End Sub

Private Sub Dates_i_Dépassement()   'événement de dépassement d'une date
     Call Mail_small_Text_Outlook    'envoi mail
End Sub

Private Sub Fermeture() 'fermeture fichier avec sauvegarde des modifications
     ThisWorkbook.Close SaveChanges:=True
End Sub

bonsoir thev , la fermeture effectué sauf aprés exécution du code n'est pas d'une façon automatique c'est à dire n'est pas quand atteint le 18h le fichier se ferme automatque tu as obligé d’exécuter pour se ferme à 18h

Pourtant la fermeture automatique a parfaitement fonctionné chez moi. Il faut évidemment que le fichier ait été ouvert avant 18h.

bonsoir bomaintenant chez moi 21h14min j'ai changé dans le code

 ("18:00:00")

par ("21h20min ") et j'ai attend juqu'a 6minute pour tester mais l'heure depasse son seuil est pas de fermeture lorsque j'exécute le code le fichier se ferme

tu vois merci de me repondre

Il faut fermer le fichier puis le rouvrir pour que la fermeture automatique se fasse, La programmation de la fermeture automatique s'exécute à l'ouverture du fichier.

bonsoir thev merci oui se ferme mais pas totalement il reste l'excel ouvert mais le classeur caché comme l'indique le capture d'ecran

est ce que possible de fermer totalement le ficheir excel ?

Le classeur n'est pas caché mais bien fermé. L'application Excel reste ouverte. Si vous voulez la fermer, il suffit de modifier la procédure de fermeture comme suit :

Private Sub Fermeture() 'fermeture fichier et application Excel avec sauvegarde des modifications
     ThisWorkbook.Save
    Application.Quit
End Sub

salut thev c'est parfait exactement finalement je vais accepter cette solution car elle est plus proche de mon besoin et merci beaucoup autre fois pour votre propre aide ,maintenant j'ai une autre probléme ,bon est ce que possible de m'aider sur un autre travail dans le fichier si dessous et le travail concerne uniquement les feuilles 3,4 et 6 ces feuilles contient un planification des taches d'intervention préventive par semaine et par mois et annuel

travail demandée : je vais enregistrer automatiquement ces taches ça veut dire que lorsque je fais l'appel sur planning par semaine il m'affiche automatiquement la liste des taches conçernée par semaine

et si je fais l'appel au plannig par mois il m'affiche la liste des taches conçerné et de meme si je fais l'appel au plannin annuel il m'affiche uniquement les taches concerné

parexemple avec un userform par exemple tu met 3 icone comme suit plannig par semaine , plannig par mois et plannig par année une fois tu clique sur le bouton planning par semaine il m'affiche la liste conçerné et de meme pour les autres , en attendant votre réponse je vous souhaite la bonne contunuation et merci

Bonjour,

C'est une nouvelle problématique. Pour respecter les règles de ce Forum et afin que d'autres membres participent, vous devez ouvrir un nouveau sujet de discussion.

bonsoir thev ok je vais preparer un nouveau sujet et par la suite je le publierai non de sujet "planning preventive automatique "

merci d'avance