Discussion :

[perouse07]

Bonjour, pourriez vous m'éclairez ?
J'ai un problème avec cette macro. Je ne veux pas envoyer un autre rendez vous si dans ma colonne K il y a "oui"
Je pense n'avoir rien oublier mais cela ne fonctionne pas. Il me récréé des Rendez-vous même si la cellule est rempli ..

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Option Explicit
 
 
 
Sub AjoutRV()
  Dim DLig As Long, Lig As Long
  Dim OutObj As Object, OutAppt As Object
  Dim DateRdv As Date, FlgRdv As Boolean
 
  ' Créer une instance d'Outlook
 Set OutObj = CreateObject("outlook.application")
  ' Avec la feuille
 With Sheets("base")
    DLig = .Range("G" & Rows.Count).End(xlUp).Row
    ' Pour chaque ligne
   For Lig = 5 To DLig
 
        ' Si un RDV n'a pas déjà été créé
       If .Range("K" & Lig) <> "" Then
          ' Si le commentaire à changé
         If .Range("K" & Lig).Comment.Text <> .Range("E" & Lig).Value Then
            FlgRdv = True
          Else
            ' Sinon le commentaire n'a pas changé = pas de RDV
           FlgRdv = False
          End If
        Else
          ' Sinon, pas de RDV déjà créé
         FlgRdv = True
        End If
 
 
      ' Si le FLAG est à vrai on créé le RDV
     If FlgRdv Then
        DateRdv = Range("G" & Lig)
        Set OutAppt = OutObj.CreateItem(1)
        With OutAppt
          .Subject = "XXXX : " & Sheets("base").Range("B" & Lig) & "" & Sheets("base").Range("E" & Lig) & " se situant " & Sheets("base").Range("F" & Lig)
          .Start = DateRdv
          .Duration = 60
          .ReminderSet = True
          .Save
        End With
        ' Créer le commentaire et inscrire Oui
       On Error Resume Next
        .Range("K" & Lig).Comment.Delete
        .Range("K" & Lig).AddComment Text:="XXX : " & Sheets("base").Range("H" & Lig).Value & " jours."
        .Range("K" & Lig) = "Oui"
        On Error GoTo 0
      End If
    Next Lig
  End With
  Set OutAppt = Nothing
End Sub

[Invité]

Bonjour,

Pourquoi a-t-on la ligne de code suivante ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

       .Range("K" & Lig).AddComment Text:="XXX : " & Sheets("base").Range("H" & Lig).Value & " jours."

et non pas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

        .Range("K" & Lig).AddComment Text:=.Range("E" & Lig)

Puisque c'est le contenu de la colonne E qui est testé.


Cordialement.