Discussion :

[Menalm11]

Bonjour Famille,

J'ai un petit souci avec mon code, j'ai cherché bcoup mais j'ai pas trouve une solution
En gros, j'ai une feuille, ou je veux s'il y'a une modification un e-mail serait envoyer. J'ai écrit le code et tous marche. Sauf que je voulais dans le corps de mon e-mail recevoir les données de la ligne où la modification a été faite. Pour vous donner une idée, voici mon code:

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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
Option Explicit
Dim ValCell As Variant
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim Destinataire As String, xOutApp As Object, OutMail As Object, xMailItem As String
    Dim xMailBody As String, SigString As String, Signature As String, DernLigne As Long, nomfeuille As String, ThisRow As Long
Dim i As Integer, Cpt As Integer, CptSh As Integer, dercol As Long
On Error Resume Next
If Target.Column = 10 And Target.Value = "Gagnée" Then
 
Application.EnableEvents = False
   If MsgBox("Êtes-vous certain de rendre l'offre gagnée? ", vbYesNo + vbExclamation + vbDefaultButton2, "Modification d'état de vente") = vbNo Then
    Target.Value = ValCell
    Else
    Cpt = 0
    CptSh = Sheets.Count
    For i = 1 To CptSh
        If Sheets(i).Name <> "Clients Gagnés 2021" Then Cpt = Cpt + 1 Else Exit For
    Next i
    If Cpt = CptSh Then
         Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Clients Gagnés 2021"
         Sheets("Affaires 2021").Rows(1).EntireRow.Copy
         Sheets("Clients Gagnés 2021").Select
Sheets("Clients Gagnés 2021").Cells(1, 1).EntireRow.Select
ActiveSheet.Paste
   Application.CutCopyMode = False
 
   dercol = Sheets("Clients Gagnés 2021").Range("IV1").End(xlToLeft).Column + 1
   Sheets("Clients Gagnés 2021").Cells(1, dercol).Value = "N°Installation"
    Sheets("Clients Gagnés 2021").Range("A1").Select
     ActiveWindow.SmallScroll ToRight:=23
     Selection.Copy
     Sheets("Clients Gagnés 2021").Cells(1, dercol).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    End If
    DernLigne = Sheets("Clients Gagnés 2021").Range("a65536").End(xlUp).Row + 1
    ThisRow = Target.Row
    Sheets("Affaires 2021").Rows(ThisRow).EntireRow.Copy
         Sheets("Clients Gagnés 2021").Select
Sheets("Clients Gagnés 2021").Cells(DernLigne, 1).EntireRow.Select
ActiveSheet.Paste
   Application.CutCopyMode = False
 
        Set xOutApp = CreateObject("Outlook.Application")
        Set OutMail = xOutApp.CreateItem(0)
        Destinataire = "xx.x@xx.com"
        xMailItem = "Une nouvelle offre a été rapportée"
        xMailBody = ""
        SigString = Environ("appdata") & _
                "\Microsoft\Signatures\x.htm"
    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If
    On Error Resume Next
        With OutMail
            .To = Destinataire
            .Subject = xMailItem
            .HTMLBody = xMailBody & "<br>" & Signature
            .Attachments.Add (ThisWorkbook.FullName)
            .Display
        End With
        Sheets("Clients Gagnés 2021").Select
        nomfeuille = ActiveSheet.Name
        MsgBox ("Un e-mail a été envoyé à " & Destinataire & " et le nouveau client gagné a été ajouté à la feuille " & nomfeuille)
        End If
  Application.EnableEvents = True
 End If
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Sheets("Clients Gagnés 2021").Range("A" & DernLigne).RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
Function GetBoiler(ByVal sFile As String) As String
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 If Target.Column = 10 And Target.Count = 1 Then
   ValCell = Target
 End If
End Sub

J'ai besoin de votre aide vraiment, je suis débutent

[Zekraoui_Jakani]

Ajouter une balise (flag) en regard de la ligne où la modification a été faite; ce flag notera le n° de la ligne via la procédure événementielle de votre feuille "WorkSheet_Change".
Récupérer ce numéro pour l'exploiter dans le mail.

[Menalm11]

Merci pour ta suggestion, mais étant débutante je ne connais pas comment le faire . STP Tu peux écrire ta suggestion sous forme de code ?

[Zekraoui_Jakani]

Ajoutez ceci à la fin de votre code:

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
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MyRange As Range    'la zone où se font les modifications
    Dim myRow As Long   'la dernière ligne de la zone modifiable
    Dim z As Long   'le numéro de la ligne ayant été modifiée
 
    z = Target.Row
    myRow = Cells(Rows.Count, 1).End(xlUp).Row
 
    'on suppose que la zone modifiable est "A:S": à adapter !!!!!
    Set MyRange = Range("A1:S" & myRow)
 
    'On définit la colonne où l'on met un "X" en face de la ligne modifiée
    'ici, on a choisit la colonne "T", mais vous pouvez choisir la 1ère colonne libre à droite; à adapter !!!!!
    If Not Intersect(Target, MyRange) Is Nothing Then
        Range("T1:T" & myRow).ClearContents
        Cells(z, 20) = "X"
        'le message ci-dessous, contient l'info voulue, que vous pouvez exploiter dans le mail
        MsgBox "La ligne modifiée est : " & z & " adresse : " & Target.Address
    End If
 
End Sub

[Menalm11]

Merci infiniment pour ton aide