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
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) | O | P | Q | R | Total/semaine (S) | U | |
| 1 | 0 | 0 | 0 | 0 | 0 | 0 | |
| 2 | 6 | 10 | 0 | 0 | 16 | 16 | |
| 3 | 5 | 16 | 0 | 0 | 21 | 37 | |
| 4 | 8 | 16 | 0 | 0 | 24 | 61 | |
| 5 | 4 | 2 | 0 | 0 | 6 | 67 | |
| 6 | 11 | 0 | 0 | 0 | 11 | 78 | |
| 7 | 8 | 10 | 0 | 0 | 18 | 96 | |
| 8 | 6 | 14 | 0 | 0 | 20 | 116 | |
| 9 | 11 | 17 | 0 | 0 | 28 | 144 | |
| 10 | 11 | 17 | 0 | 0 | 28 | 172 | |
| 11 | 16 | 16 | 0 | 0 | 32 | 4 | |
| 12 | 12 | 17 | 3 | 0 | 32 | 36 | |
| 13 | 3 | 17 | 8 | 5 | 33 | 69 | |
| 14 | 0 | 16 | 0 | 8 | 24 | 93 | |
| 15 | 0 | 17 | 9 | 9 | 35 | 128 |
