Lister dans une fenêtre

        'ajoute la liste depuis Fauil2 et l'adapte au texte
        Set Fenetre = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, Gauche, Haut, 1, 1)
[B][COLOR="Green"]Fenetre.Name = "Commentaire"[/COLOR][/B]
        With Fenetre
 [B][COLOR="Red"]           .Name = "Commentaire"[/COLOR][/B]

With Fenetre
            .Name = "Commentaire"

            With .TextFrame
                If Len(Texte) > 0 Then
                    .Characters.Text = Left(Texte, Len(Texte) - 1)
                Else: .Characters.Text = "Mot introuvable"
                End If
                .AutoSize = True
            End With

            .Visible = True
            .Fill.Visible = msoTrue
            .Fill.ForeColor.SchemeColor = 65
            .Fill.BackColor.SchemeColor = 13
            .Fill.TwoColorGradient msoGradientHorizontal, 2
        End With

Public Sub affichagefen(ByVal Target As Range)
    Dim sht2, sht3 As Worksheet
    Dim Fenetre, shp As Shape
    Dim Haut As Single
    Dim Gauche As Single
    Dim Texte, ch, Motrech, ActiveFen As String
    Dim Cel As Range
    Dim Lst1, Lst2 As String
[B][COLOR="Green"]On Error Resume Next
ActiveSheet.Shapes(1).Delete
On Error GoTo 0[/COLOR][/B]
    Set sht2 = Sheets("feuil2")
    Set sht3 = Sheets("feuil3")
    Texte = ""
    Motrech = ""
    If Target.Column = 1 And Target.Count = 1 Then
[B][COLOR="Red"]        For Each shp In ActiveSheet.Shapes
            If Not Intersect(shp.TopLeftCell, Target.Offset(, 1)) Is Nothing Then
                MsgBox "Nom Cadre / Target : " & shp.Name
                MsgBox "Suppr. ? " & shp.Name
                shp.Delete
            End If
        Next
        '----------------------
        If Right(Target.Value, 2) <> "--" And Right(Target.Value, 2) <> "-+" Then

            'supprime la fenetre si le texte dans la cellule
            'active ne se termine pas par "--" ou "-+"
            On Error Resume Next
            Set Fenetre = ActiveSheet.Shapes("Commentaire")
            If Err.Number = 0 Then Fenetre.Delete
            On Error GoTo 0
        End If[/COLOR][/B]

Set Fenetre = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, Gauche, Haut, 1, 1)

Public Sub listefenetre(ByVal Taregt As Range, Fenetre As Object, Texte As String)
    With Target
        Haut = .Top + 4
        Gauche = .Left + .Width + 6
    End With

    'ajoute la liste depuis Fauil2 et l'adapte au texte
    Set Fenetre = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, Gauche, Haut, 1, 1)

    With Fenetre
        .Name = "Commentaire"

        With .TextFrame
            If Len(Texte) > 0 Then
                .Characters.text = Left(Texte, Len(Texte) - 1)
            Else: .Characters.text = "Mot introuvable"
            End If
            .AutoSize = True
        End With

        .Visible = True
        .Fill.Visible = msoTrue
        .Fill.ForeColor.SchemeColor = 65
        .Fill.BackColor.SchemeColor = 13
        .Fill.TwoColorGradient msoGradientHorizontal, 2
    End With
    Set Fenetre = Nothing
End Sub

Call listefenetre(Target, Fenetre, Texte)

Public Sub listefenetre(ByVal [COLOR=Red]Taregt [/COLOR]As Range, Fenetre As Object, Texte As String)

   Dim Texte,ch, Motrech, ActiveFen As String

Call listefenetre(Target, Fenetre, Texte)

Set Fenetre = UnObjetQuelconque

Texte = "blabla"
'Call listefenetre(Target, Fenetre, Texte)
listefenetre(Target, Fenetre, Texte)

 'For Each Cel In sht2.Range("B2", sht2.Range([COLOR=Red][B]"[/B][B]B65536[/B][/COLOR]").End(xlUp))

  For Each Cel In sht2.Range("B2", sht2.Range([B][COLOR=Red]"B" & Application.Rows.Count[/COLOR][/B]).End(xlUp))

Public Function RechercheMot(ByVal Target As Range) As String
    Dim Str As String
       G = Split(Target, "-")
    For a = 0 To UBound(G)
     If G(a) <> "" Then
          Str = Str & G(a)
     End If
    Next
     RechercheMot = Str
End Function

On Error Resume Next
    Set Fenetre = ActiveSheet.Shapes("Commentaire")
    If Err.Number = 0 Then Fenetre.Delete
    On Error GoTo 0