Microsoft 365 Problème macro événementielle

[ExcLnoob]

Bonsoir le Forum,

J'ai un petit souci avec 1 code implémenté dans une de mes feuilles...
Il fait bien le taf mais je souhaiterai en ligne 59 que Cel soit égal à la cellule que je viens de renseigner. Or quand je tape sur entrée ou tabulation le Cel.Offset dans e mail part de la cellule sur laquelle j’atterris quand je tape entrée ou tabulation soit celle d'en dessous ou celle d'à côté, ce qui me décale toutes les infos que je voudrai faire apparaître dans le mail... (logique...).
Comment indiqué que Cel soit égal à la dernière cellule de la ligne remplie de la colonne W ?

De plus, j'ai fais du bricolage sur cette macro et parfois, mais je n'arrive pas à comprendre la raison et c'est vraiment aléatoire pour moi, je rencontre des bugs qui me rapporte un message d'erreur du type

erreur d’exécution -2147467259 (80004005) ​

De plus cela me fait planter Outlook également et je suis obligé de le redémarrer. Sauriez-vous où j'ai fait une erreur (mis à part créer une macro "Frankenstein"..) ?

Je vous remercie par avance pour votre aide..
Le code :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cel As Range
Dim OL As Object, myItem As Object, wDoc As Object, rng As Object
Dim fichier As String, plage_mail As Range
Dim PJ As Variant
Dim j As Integer


    Set OL = CreateObject("Outlook.Application")
    Set myItem = OL.CreateItem(olMailItem)
    Set wDoc = myItem.GetInspector.WordEditor
    
  
If Not Intersect(Target, Columns("Q:Q")) Is Nothing Then
   If Target.Count <> 1 Then Exit Sub
   If Target = "" Then Exit Sub
   If Application.WorksheetFunction.CountIf(Range("Q:Q"), Target) <= 1 Then Exit Sub
   If MsgBox("This invoice number already exists." & vbLf & "Are you sure that this invoice number is correct ?", vbYesNo + vbCritical, "WARNING !!!") = vbYes Then
    Exit Sub
Else
    MsgBox "Please contact support", vbExclamation, "Information"
   Target = "": Target.Select
    End If
End If

If Not Intersect(Target, Columns(22)) Is Nothing Then

    If ActiveCell = "" Then
        Exit Sub
    End If
    
Set Cel = Feuil4.UsedRange.Find(Target.Value, , xlValues, xlWhole)

    If Cel Is Nothing Then
        MsgBox "PO doesn't exists" & Chr(10) & "Please contact support", vbCritical, "WARNING !!!"
        ActiveCell.Value = ""
Else

    If Not Cel Is Nothing And Cel.Offset(0, 10) > 0 Then
        MsgBox "Remaining provisions on PO :" & Chr(10) & Format(Cel.Offset(0, 10), "#,##0.00 €"), vbInformation, "NOTE"
        
Else

    If Not Cel Is Nothing And Cel.Offset(0, 10) < 0 Then
        MsgBox "No more provision on PO :" & Chr(10) & Format(Cel.Offset(0, 10), "#,##0.00 €") & Chr(10) & "Please contact support", vbCritical, "WARNING !!!"
  
Else

    If Not Cel Is Nothing And Cel1.Offset(0, 10) = 0 Then
        MsgBox "PO closed" & Chr(10) & "Please contact support" & Chr(10) & "Otherwise payment will not be able to made.", vbInformation, "NOTE"

    End If
    End If
    End If
    End If
    End If
    
Set Cel = ActiveCell
    
If Not Intersect(Target, Columns("W:W")) Is Nothing Then
  If Target.Count <> 1 Then Exit Sub
   If Target = "" Then Exit Sub
   If MsgBox("New invoice implemented." & vbLf & "Do you want send email to requestor ?", vbYesNo + vbInformation, "Information") = vbYes Then

MsgBox "Please select PO to attach.", vbExclamation
    PJ = Application.GetOpenFilename("Tous les fichiers (*.*),*.* ", 1, "Select your PO.", , True)
    If IsArray(PJ) = False Then
        MsgBox "Operation cancelled !", vbCritical, "Information"
        Target = ""
Exit Sub
End If

    MsgBox "Email in preparation..." , vbExclamation

If Worksheets("Feuil1").Activate Then
    With myItem
        
        .To = Cel.Offset(0, 14) & "; xxxx@xxxx.com"
        .CC = ""
        .Subject = "Local invoice - Validation and payment - " & Cel.Offset(0, -17)
        .Body = "Hi," & vbCrLf & vbCrLf & _
        "For validation and payment please." & vbCrLf & vbCrLf & _
        "Invoice number : " & Cel.Offset(0, -6) & vbCrLf & _
        "Due date : " & Cel.Offset(0, -3) & vbCrLf & _
        "PO attached"
            For j = 1 To UBound(PJ)
        .attachments.Add PJ(j)
            Next
        .Display
    End With
End If
   Else
   Target = ""

End If
End If

    Set OL = Nothing: Set myItem = Nothing: Set wDoc = Nothing
End Sub

Merci par avance pour votre aide

 

[Compte Supprimé 979]

Bonjour ExcLnoob

Quand on utilise un évènement "Change", pour toute modification de cellule dans la sub, il faut penser à arrêter les évènements le temps de traitement, sinon on court au devant de gros ennuis

Donc quand je vois ça

    If Cel Is Nothing Then
      MsgBox "PO doesn't exists" & Chr(10) & "Please contact support", vbCritical, "WARNING !!!"
      ActiveCell.Value = ""
    Else

Je me dis que forcément il y aura un problème
A remplacer donc par

    If Cel Is Nothing Then
      MsgBox "PO doesn't exists" & Chr(10) & "Please contact support", vbCritical, "WARNING !!!"
      Application.EnableEvents = False
      ActiveCell.Value = ""
      Application.EnableEvents = True
    Else

Ensuite avec

Set Cel = ActiveCell

Pourquoi ? Quelle utilité ?

Bref pas mal de choses à corriger

A+

 

[ExcLnoob]

Bonjour le Forum,
@BrunoM45 je te remercie pour ton retour. Je vais appliquer tes conseils, merci.

Pour ce qui est de la ligne

Set Cel = ActiveCell

Elle me sert de cellule de référence pour insérer dans mon mail les valeurs de certaines cellules. C'est là où j'aimerai que ce soit toujours la dernière cellule remplie de la colonne W..