Code ne s'exécute qu'à la deuxième action

[isa44]

Bonjour , j'ai un problème avec un code qui oblige de rentrer un commentaire dans une cellule :

Ce code fonctionne bien s'il est exécuté directement :

Private Sub Worksheet_Change(ByVal target As Range)


   Application.ScreenUpdating = False
   
   'rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr   obligation de commentaire rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr

Dim commentaire As Variant
Dim k As Variant


If Not Intersect(target, Range("A32:C41")) Is Nothing Then
On Error Resume Next
If target = "" Then target.ClearComments
If target <> "" Then
    target.ClearComments
    target.AddComment
    
    


boucle:


   commentaire = InputBox((Now) & Chr(10) & Chr(10) & "Indiquez la cause de l'indisponibilité", "Saisie commentaire ")
If commentaire = "" Then MsgBox "Vous devez saisir obligatoirement un commentaire"
If commentaire = "" Then GoTo boucle



target.Comment.Text Text:=commentaire





        target.Comment.Text Text:=CStr(Now) & Chr(10) & Chr(10) & target.Comment.Text & Chr(10)
    lg = Len(target.Comment.Text)
    With target.Comment.Shape.TextFrame
      .Characters(Start:=1, Length:=lg).Font.Name = "Verdana"
      .Characters(Start:=1, Length:=lg).Font.Size = 10
      .Characters(Start:=1, Length:=lg).Font.Bold = True
      .Characters(Start:=1, Length:=lg).Font.ColorIndex = 1
      .Characters(Start:=lg, Length:=99).Font.ColorIndex = 1
    End With

    With target.Comment.Shape ' taille du commentaire
    .Width = 120 '
    .Height = 90
    End With


 End If
End If


'  couleur de fond commentaires

    k = Range("A30:C45")
      For Each k In ActiveSheet.Comments
        k.Shape.Fill.ForeColor.SchemeColor = 5
        k.Shape.AutoShapeType = msoShapeRoundedRectangle
      Next k
End Sub

Mais si celui est exécuté juste avant le commentaire n'est pas retenu dans la cellule la première fois.
Il faut une autre action de changement pour qu'il garde enfin le commentaire !

 Sub Worksheet_Deactivate()

Dim origine As Variant
Dim j As Long
Dim Plage As Range
Dim Cel As Range
Dim Msg As String


 Set origine = ActiveSheet


Application.EnableEvents = False 'Bloque l'exécution des autres macros
Application.ScreenUpdating = False


    Sheets("ROSE").Visible = True


    With Sheets("ROSE").Select

                   COPIE_dans_OPTH 'copie les BUS dans la feuille OPTHOR

            Application.ScreenUpdating = False


        Set Plage = Range("C3:C27,H6:H30,M6:M37,R6:R39,A32:C41,H32:H41,F40:F41") 'Contrôle s'il manque des N°
        For j = 7 To 166
          Set Cel = Plage.Find(What:=Sheets("PARC").Range("C" & j), LookIn:=xlValues, LookAt:=xlWhole)
          If Cel Is Nothing Then
            Msg = Msg & ", " & Sheets("PARC").Range("C" & j)
          End If
         Next j

          If Len(Msg) > 0 Then

            Application.ScreenUpdating = True
            Sheets("ROSE").Activate

            MsgBox " Attention il manque les N° suivants :   " & Mid(Msg, 3) & Chr(10) & Chr(10) & "   Veuillez les postionner dans la feuille de remisage avec un commentaire s'ils sont indisponible", vbInformation + vbOKOnly
            If Len(Msg) > 0 Then Exit Sub
                    
          End If
          
 
          
        End With


Application.EnableEvents = False 'Bloque l'exécution des autres macros

origine.Select

Application.EnableEvents = True 'Remet l'exécution des autres macros

        
End Sub

Comment résoudre ce mystérieux phénomène ?

 

[pierrejean]

Re : Code ne s'exécute qu'à la deuxième action

Bonjour Isa

J'ai testé rapidement et pas aperçu de probleme
Peux-tu preciser la sequence qui t'en pose un ???

 

[ERIC S]

Re : Code ne s'exécute qu'à la deuxième action

Bonjour Isa

c'est une belle histoire, ton histoire :

si le code ne génère pas d'erreur, pour nous il sera bon. Cela ne veut pas dire qu'il correspond à ton besoin.

1/ un fichier serait bien

2/ quelques mots simples : je fais ceci, je veux cela pour compléter


Moi si j'ouvre excel et que je mets ton code dans un fichier, je le mets où : Feuil1, Feuil2, ...
et si je n'ai pas d'onglet rose je me tape une erreur à résoudre.....

Bref, un exemple svp

edit : j'en oublie de dire bonjour à PierreJean