Liste de validation - flèches qui disparaissent

[tototiti2008]

Bonjour à tous,

J'ai fouillé un peu partout (j'espère ne pas avoir loupé la réponse auquel cas je vous présente mes plates excuses 😉) et j'ai vu que le thème était assez récurrent mais qu'il y avait assez rarement des réponses satisfaisantes
Si on met une liste de validation dans une colonne (B de la feuille Données dans l'exemple), on a bien les flèches de validation (logique)

J'ai fait, pour la colonne C, une macro qui insère l'image de feuille dans la cellule active si on clique sur l'image de feuille. Celle-ci gère également l'effacement de l'éventuelle image présente dans la cellule active

Si on sélectionne une cellule de la colonne C et qu'on clique sur l'image de feuille, elle s'insère dans la cellule (macro, normal)
Mais toutes les flèches de validation ont disparu !

Edit : en faisant tourner en pas à pas, j'ai vu qu'il supprimait aussi des shapes nommées du type "Drop Down 6" malgré qu'elles ne sont pas dans la cellule active, ce qui explique la disparition des flèches !!!
Maintenant la question qui tue : comment les faire réapparaître 😕

Merci d'avance

 

[Robert]

Re : Liste de validation - flèches qui disparaissent

Bonjour Tototiti, bonjour le forum,

peut-être comme ça :

With Selection.Validation
     .InCellDropdown = True
End With

 

[david84]

Re : Liste de validation - flèches qui disparaissent

Bonjour tout le monde,
Je n'ai pas compris la finalité donc...mais en testant comme cela tu ne perds pas tes flèches :

Sub InsereIm(NomImage As String)
Dim Sh As Shape
    Application.ScreenUpdating = False
    If ActiveCell.Address <> Range("Choix").Address Then
        'Suppression de l'image existante
        On Error Resume Next
        For Each Sh In ActiveSheet.Shapes
            If Sh.TopLeftCell.Address = ActiveCell.Address Then Sh.Cut
        Next Sh
        On Error GoTo 0
        'Insertion image
        Sheets("Images").Shapes(NomImage).Copy
        ActiveSheet.Paste
        If Selection.ShapeRange.Height > ActiveCell.Height Then
            Selection.ShapeRange.Top = ActiveCell.Top
        Else
            Selection.ShapeRange.Top = ActiveCell.Top + (ActiveCell.Height - Selection.ShapeRange.Height) / 2
        End If
        If Selection.ShapeRange.Width > ActiveCell.Width Then
            Selection.ShapeRange.Left = ActiveCell.Left
        Else
            Selection.ShapeRange.Left = ActiveCell.Left + (ActiveCell.Width - Selection.ShapeRange.Width) / 2
        End If
        ActiveCell.Select
        Application.CutCopyMode = False
    End If
    On Error Resume Next
        For Each Sh In ActiveSheet.Shapes
            If Sh.TopLeftCell.Address = ActiveCell.Address Then Sh.Copy
        Next Sh
        On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

Peut-être même que la dernière partie de la macro (Sh.copy) ne s'impose pas mais dans ce cas, trouver le moyen de vider le presse-papier.
A+

 

[tototiti2008]

Re : Liste de validation - flèches qui disparaissent

Bonjour CC, Bonjour Robert 😉

Eh non, désolé, l'image a carrément été supprimée
En plus c'est une image un peu bizarre, pas possible de la copier d'une autre feuille ayant une liste de validation

J'ai peur que la seule solution soit de recréer une feuille...

 

[tototiti2008]

Re : Liste de validation - flèches qui disparaissent

Bonjour David,
Re,

Merci pour ta proposition

moi j'ai remplacé

        For Each Sh In ActiveSheet.Shapes
            If Sh.TopLeftCell.Address = ActiveCell.Address Then Sh.Delete
        Next Sh

par

        For Each Sh In ActiveSheet.Shapes
            If Sh.FormControlType <> xlDropDown Then
                If Sh.TopLeftCell.Address = ActiveCell.Address Then Sh.Delete
            End If
        Next Sh

Mais une fois qu'elle est supprimée, elle est supprimée 🙂
Bon, j'ai recréé une feuille, je considère la question comme résolue, Merci à tous 😉

 

[klin89]

Re : Liste de validation - flèches qui disparaissent

Bonjour à tous,

en rajoutant un test :

For Each Sh In ActiveSheet.Shapes
    If Sh.AutoShapeType <> msoShapeMixed Then
       If Sh.TopLeftCell.Address = ActiveCell.Address Then Sh.Delete
     End If
Next Sh

Klin89

 

[tototiti2008]

Re : Liste de validation - flèches qui disparaissent

Bonjour klin,

Merci de ta proposition 🙂, ça marche aussi

 

[tototiti2008]

Re : Liste de validation - flèches qui disparaissent

Bonjour à tous,

Juste une précision : en fait tous ces soucis viennent du fameux "On error resume next"

Une autre façon de faire serait peut-être

        On Error Goto finSuppr
        For Each Sh In ActiveSheet.Shapes
            If Sh.TopLeftCell.Address = ActiveCell.Address Then Sh.Cut
finSuppr :
        Next Sh
        On Error GoTo 0

En répondant à une question sur un autre fil (https://www.excel-downloads.com/threads/suppression-de-liste-deroulante-controle-formulaire.168737/), je me suis rendu compte qu'il était très difficile de faire la différence entre les flèches de listes de validation et un contrôle de formulaire Combobox dans les Shapes de la feuille, à part qu'un a une propriété TopLeftCell et l'autre non...