Afficher et masquer l'infobul sous condition

[Ilino]

Bonsoir Forum
ci joint mon fichier que ce bug , mon souci est le suivant :
si N18<> de vide afficher dans la cellule P18 Info bul et une fois la cellule P18 rempli masquer l'info bul
NB : le commentaire dans Infobul " Veuillez selectionnez une unité"
Grazie

 

[Ilino]

Re : Afficher et masquer l'infobul sous condition

forum Bonsoir
je souhaiterai ce programme en VB ( il existe deja dans mon fichier mais ????)
a+

 

[Ilino]

Re : Afficher et masquer l'infobul sous condition

Bonsoir
puis je avoir votre attention ???
Grazie

 

[Ilino]

Re : Afficher et masquer l'infobul sous condition

Re Bonsoir
ci dessous le code

Private Sub Worksheet_Change(ByVal Target As Range)
If Range("N18").Value <> "" Then
'Range("N18").ClearComments 'je supprime le commentaire existant
Range("P18").AddComment 'je créé le commentaire
Range("P18").Comment.Visible = True
commentaire = Range("P18").Text
Range("P18").Comment.Text Text:=commentaire
Else
Range("P18").ClearComments
End If
End Sub

 

[Regueiro]

Re : Afficher et masquer l'infobul sous condition

Bonsoir Ilino, Le Forum

Private Sub Worksheet_Change(ByVal Target As Range)
If Range("N18").Value <> "" Then
[P18].ClearComments
[P18].AddComment
[P18].Comment.Visible = True
[P18].Comment.Text Text:="Veuillez Sélectionner une Unité"
Else
[P18].ClearComments
End If
End Sub

A+

 

[Regueiro]

Re : Afficher et masquer l'infobul sous condition

Bonsoir
Le commentaire disparait après 3 secondes

Private Sub Worksheet_Change(ByVal Target As Range)
If Range("N18").Value <> "" Then
[P18].ClearComments
[P18].AddComment
[P18].Comment.Visible = True
[P18].Comment.Text Text:="Veuillez Sélectionner une Unité"
Else
[P18].ClearComments
End If
    For Each c In ActiveSheet.Comments
        c.Shape.Fill.ForeColor.SchemeColor = 6
        'c.Shape.AutoShapeType = msoShapeRoundedRectangle
        c.Shape.AutoShapeType = msoShapeHorizontalScroll
        c.Shape.OLEFormat.Object.Font.Name = "Verdana"
        c.Shape.OLEFormat.Object.Font.Size = 14
        c.Shape.TextFrame.AutoSize = True
    Next c
   If Not Intersect([P18], Target) Is Nothing And Target.Count = 1 Then
    If Target <> "" Then
    Target.Comment.Shape.Fill.ForeColor.SchemeColor = 52
    Target.Comment.Text Text:="Merci"
    fin = Timer + 3
        Do While Timer < fin
            DoEvents
        Loop
    Target.ClearComments
    Else
    Target.Comment.Visible = True
 End If
 End If
 

End Sub

Bonne Nuit

 

[Ilino]

Re : Afficher et masquer l'infobul sous condition

Bonjour Forum
Bonjour Regueiro
Merci pour la réponse , mais il y a un petit souci dans le code , si je selectionne et je valide une autre cellule dans la feuille , le commentaire s'affiche une autre fois ?????
A+

 

[Regueiro]

Re : Afficher et masquer l'infobul sous condition

Bonsoir Ilino, Le Forum

Avec ce code c'est OK sur mon PC
Par contre il faut défusionner N18😱18

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect([N18], Target) Is Nothing And Target.Count = 1 Then
        If Target <> "" Then
            Target.Offset(, 2).ClearComments
            Target.Offset(, 2).AddComment
            Target.Offset(, 2).Comment.Visible = True
            Target.Offset(, 2).Comment.Text Text:="Veuillez Sélectionner une Unité"
        Else
            Target.Offset(, 2).ClearComments
        End If
    End If
 
For Each c In ActiveSheet.Comments
    c.Shape.Fill.ForeColor.SchemeColor = 6
    'c.Shape.AutoShapeType = msoShapeRoundedRectangle
    c.Shape.AutoShapeType = msoShapeHorizontalScroll
    c.Shape.OLEFormat.Object.Font.Name = "Verdana"
    c.Shape.OLEFormat.Object.Font.Size = 14
    c.Shape.TextFrame.AutoSize = True
Next c
If Not Intersect([P18], Target) Is Nothing And Target.Count = 1 Then
    If Target <> "" Then
        Target.Comment.Shape.Fill.ForeColor.SchemeColor = 52
        Target.Comment.Text Text:="Merci"
        fin = Timer + 3
            Do While Timer < fin
                DoEvents
            Loop
        Target.ClearComments
     Else
     Target.Comment.Visible = True
End If
End If
  

End Sub