RVlalanne

RVlalanne

XLDnaute Nouveau
Bonjours à tous,

Je vous expose mon problème:
Dans un fichier excel, dans la colonne U j'ai pour chaque cellule qui est le résultat de la précédente plus celle de S de la même ligne (U3=U2+S3).
Arrivé à 200, la série revient à 0 (=SI((U11+S12)<200;(U11+S12);(U11+S12)-200)) et donc suivant la MFC (U12<U11), la cellule devient rouge.
J'aimerais donc que, en plus de devenir rouge, je recoives un courriel pour me donner le signale de commander.
J'ai ce code qui fonctionne bien dans une autre feuille excel mais qui envoi lors d'un changement seulement. Je ne suis pas loin mais il me manque juste un petit coupe de main.
Un gros merci à tous.
Private Sub Worksheet_Change(ByVal Target As Range)

Dim xRgSel As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set xRg = Range("U3:U54")
Set xRgSel = Intersect(Target, xRg)
ActiveWorkbook.Save
If Not xRgSel Is Nothing Then
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
xMailBody = "Cell(s) " & xRgSel.Address(False, False) & _
" in the worksheet '" & Me.Name & "' were modified on " & _
Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _
" by " & Environ$("username") & "."

With xMailItem
.To = "XXX@XXX.com"
.Subject = "Commander propane " & ThisWorkbook.FullName
.Body = xMailBody
.Attachments.Add (ThisWorkbook.FullName)
.Display
End With
Set xRgSel = Nothing
Set xOutApp = Nothing
Set xMailItem = Nothing
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


Semaine (N)OPQRTotal/semaine (S)U
1000000
2610001616
3516002137
4816002461
54200667
6110001178
7810001896
86140020116
911170028144
1011170028172
11161600324
121217303236
13317853369
14016082493
150179935128
 

Discussions similaires