Compter image + effacer image VBA

Bonjour,

Comme vous pourrez le voir dans le fichier joint,

Je remplis un tableau avec une "validation des données liste) et je j'affiche le résultat de la colonne suivante dans mon tableau avec en VBA

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect([C4:H7], Target) Is Nothing Then
     Application.EnableEvents = False
     On Error Resume Next
     [Liste].Find(Target, LookAt:=xlWhole).Offset(, 1).Copy Target
     Application.EnableEvents = True
  End If
End Sub

Cela vas très bien avec les symboles existant, mais j'ai besoin d'utiliser des logos personnalisés sous forme d'image (ou autre si vous connaissez d'autres possibilités)

Mais avec les images j'ai deux problèmes.

1 - Lors de mon choix, je voudrais que la macro efface l'image déjà présente quand il y en déjà une, mais je ne sais pas comment faire ?

2 - Dans mon mon tableau "bilan" je sais compter les symboles, mais je ne sais pas compter les images (en H15:I18), est-ce que vous auriez une astuce pour résoudre se problème ?

Merci d'avance pour votre aide

Patrick

Bonsoir,

Personne n'a d'idée ?

Bonjour,

Soit tu donnes un nom précis à l'image lorsque tu l'ajoutes pour pouvoir la supprimer avec son nom, soit tu dois balayer toutes les images et supprimer celles dont une partie se trouve dans la cellule.

Exemple en se basant sur le coin supérieur gauche :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim obj As Shape
    If Not Intersect([C4:H7], Target) Is Nothing Then
        Application.EnableEvents = False
        For Each obj In ActiveSheet.Shapes
            If obj.Type = msoInkComment Or obj.Type = msoPicture Then
                ' msoPicture sur 2003, msoInkComment sur 2007-2013
                If Not Intersect(obj.TopLeftCell, Target) Is Nothing Then obj.Delete
            End If
        Next obj
        On Error Resume Next
        [Liste].Find(Target, LookAt:=xlWhole).Offset(, 1).Copy Target
        Application.EnableEvents = True
    End If
End Sub

Toutes les images ayant ce coin dans la cellule modifiée sont supprimées avant l'ajout du nouveau choix..

eric

Bonjour,

Merci beaucoup Eric, ça marche exactement comme je le souhaitais.

Pour le comptage, je vais mettre des symboles invisibles (blanc / blanc)

Patrick

Tu peux compter de la même façon :

Sub test()
    MsgBox nbImages([C4:C7])
End Sub

Function nbImages(plage As Range)
    For Each obj In ActiveSheet.Shapes
        If obj.Type = msoInkComment Or obj.Type = msoPicture Then
            ' msoPicture sur 2003, msoInkComment sur 2007-2013
            If Not Intersect(obj.TopLeftCell, plage) Is Nothing Then nbImages = nbImages + 1
        End If
    Next obj
End Function

eric

Re.

Merci Eric pour cette proposition, mais ça compte toutes les images.

Alors que moi je souhaite compter les images identiques Nb Type 1 -Nb type 2 -etc.

Mais avec le symbole ça marche.

Patrick

Si tu ne dis pas tout...

Dans ce cas clic-droit sur tes images de Liste, Propriétés..., Texte de remplacement Description tu mets perso1, perso2 etc...

et :

Sub test()
    MsgBox nbImages([C4:C7], "perso2")
End Sub

Function nbImages(plage As Range, typ As String)
    For Each obj In ActiveSheet.Shapes
        If obj.Type = msoInkComment Or obj.Type = msoPicture Then
            ' msoPicture sur 2003, msoInkComment sur 2007-2013
           If Not Intersect(obj.TopLeftCell, plage) Is Nothing And obj.AlternativeText = typ Then nbImages = nbImages + 1
        End If
    Next obj
End Function

Merci pour ce complement, je vais essayé, mais il faut que je les nome au moment du chargement dans la cellule.

eriiic a écrit :

Si tu ne dis pas tout...

Je pensais qu'avec mon fichier joint, toutes les infos sur mon objectif y étaient

je les nome au moment du chargement dans la cellule

Non, dans Liste une fois pour toute.

C'est emmené par le copié-collé de l'image.

Mais bon, si ton texte blanc te suffit tu peux continuer ainsi.

eriiic a écrit :

Mais bon, si ton texte blanc te suffit tu peux continuer ainsi.

Oui ça me suffit, mais je vais essayer ton code pour comprendre et peut-être pour une autre application.

Merci

Patrick

Rechercher des sujets similaires à "compter image effacer vba"