XL 2010 Afficher une image (logo) en tant que mise en forme conditionnelle

[Varenshar]

Bonjour à tous,
Après avoir recherché sur ce forum (et d'autres) je n'ai toujours pas trouvé de solution qui me convienne:
Je cherche à insérer une image en tant mise en forme conditionnelle, sans macro et sans liste déroulante, de sorte que quelle que soit la cellule où j'inscrit la valeur correspondante, l'image s'affiche dans ladite cellule.

Il s'agit d'un planning de travail (production) composé de plusieurs onglets selon le produit à fabriquer, et un onglet qui se rempli automatiquement en fonction du produit choisi (dont le déroulement est préalablement planifié dans l'onglet correspondant). Chaque tâche est définie par un abrégé qui lorsqu'il est entré dans une cellule, met en forme ladite cellule dans une couleur définie par mise en forme conditionnelle. Il s'agit dont de faire la même chose avec les images qui correspondent en l’occurrence à des actions spécifiques (prise d'échantillon par exemple) à des moments spécifiques.

Ce planning est destiné à être utilisé par ma responsable qui connaît très peu excel, j'aimerais éviter si possible de lui compliquer la vie plus que nécessaire...

Je prépare un fichier neutre à joindre ultérieurement pour aider à mieux cerner mon problème, mais pour l'heure le temps me manque.
D'avance merci à tous ceux qui sauront m'aider, ou du moins qui essaieront !

Cdlt,
Varenshar

 

[patricktoulon]

re
avec mon fichier en exemple

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 And Target.Count = 1 Then
        If Target <> "" Then
            With ActiveSheet
                'pour le cas ou la cellule serait rensignée par vba
                For Each pict In .Pictures
                    If pict.TopLeftCell.Address = Target.Address Then
                        pict.Delete
                    End If
                Next

                For Each pict In .Pictures
                    If pict.Name = Target.Value Then p = True
                Next

                If p = True Then
                    .Pictures(Trim(Target.Text)).Copy
                    .Paste
                    With .Pictures(.Pictures.Count)
                        .Top = Target.Top + 1
                        .Left = Target.Left + 1
                        .Width = Target.Width - 2
                        .Height = Target.Height - 2
                        .Name = "img" & Target.Address(0, 0)
                        .OnAction = "Feuil1.clickcilck"
                    End With
                End If

            End With
        End If
    End If
    Target.Select
End Sub

normalement il tout ce qui correspond pas a fou,tour roi ne fera rien

 

[mapomme]

Bonjour @patricktoulon

normalement il tout ce qui correspond pas a fou,tour roi ne fera rien

Certes et je rajoute que je suis tout à fait d’accord

 

[patricktoulon]

re
bonjour mapomme j'en perds mon lat in

 

[job75]

Bonjour à tous,

Allez encore une solution :

Private Sub WorkSheet_SelectionChange(ByVal Target As Range)
WorkSheet_Change Selection
End Sub

Private Sub WorkSheet_Change(ByVal Target As Range)
Dim s As Shape, t#
For Each s In Sheets("Images").Shapes
    If LCase(s.Name) = LCase(CStr(Target(1))) Then Exit For
Next
If s Is Nothing Then Exit Sub
s.Copy
Paste
Selection.Top = Target.Top
Selection.Left = Target(1, 2).Left
ActiveCell.Select 'désélectionne l'objet
t = Timer + 5: If t > 86400 Then t = 0 'temporisation de 5 secondes
While Timer < t: DoEvents: Wend
DrawingObjects.Delete
End Sub

A+

 

[Varenshar]

Alors là, chapeau, et un immense merci ! Et ça fonctionne dans mon propre fichier (Bouclier activé, en attente de lapidation) en supprimant la ligne qui m'ennuie (Je ne veux pas être limité à la 1ère colone)

J'essaie de comprendre ce que tu as ajouté:
Si le terme entré = le nom d'une image p=vrai
Si p=vrai : copie et colle l'image associée.

J'ai bon?

Je ne comprend pas grand chose de la syntaxe, j'essaie de traduire dans mon langage de non initié

 

[patricktoulon]

re
oui tu a bon c'est bien ca que cela veut dire

job75 je comprends pas ton point de vue avec cet événement on est sensé pouvoir sélectionner et re sélectionner avec une shape couvrant la cellule, ca me parait difficile avec ton model

@Varenshar
j'ai mis des commentaires

j'ai ajouté une sub de test pour te montrer que ca fonctionne aussi si la valeur est changer par vba

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 And Target.Count = 1 Then    'si la colonne est la 1 et si il y a qu'une cellule dans target
        If Target <> "" Then    'si la cellule est vide
            With ActiveSheet
                'pour le cas ou la cellule serait rensignée par vba
                'on controle qu'il est est pas une image sur cette cellule et on la supprime si c'est le cas
                For Each pict In .Pictures
                    If pict.TopLeftCell.Address = Target.Address Then
                        pict.Delete
                    End If
                Next
                'on controle maintenant si le mot tapé ou injecté par vba correspond a une image si oui p=vrai
                For Each pict In .Pictures
                    If pict.Name = Target.Value Then p = True
                Next
                'et enfin si p=vrai
                If p = True Then
                    .Pictures(Trim(Target.Text)).Copy    'on copie l'image qui porte comme nom le mot tapé dans la cellule
                    .Paste
                    With .Pictures(.Pictures.Count)    ' et on la positionne et dimentionne comme la cellule
                        .Top = Target.Top + 1
                        .Left = Target.Left + 1
                        .Width = Target.Width - 2
                        .Height = Target.Height - 2
                        .Name = "img" & Target.Address(0, 0)
                        .OnAction = "Feuil1.clickcilck"    'on affecte la macro clickclik cette nouvelle image  limage
                    End With
                End If

            End With
        End If
    End If
    Target.Select
End Sub
Sub clickcilck()
'application.caller donne le nom de la shape(image) qui a appelé clickclick
'determine la cellule ou se trouve la shape
    Set cel = Shapes(Application.Caller).TopLeftCell
    cel.ClearContents    'vide la cellule
    Shapes(Application.Caller).Delete    'supprime l'image qui a appelé clickclick
    cel.Select    'selectionne la cellule ou se trouvait l'image
    'resultat
    'quand on selectionne l'image sur une cellule on sélectionne la cellule
    'c'est bien ce que tu voulais non?
End Sub

'test par injection vba
Sub test()

    [A4] = "tour"
End Sub

buche bien demain interro surprise

 

[Varenshar]

Bien le bonjour mon cher patricktoulon,
Tes explications me permettent enfin de comprendre un (petit) peu ce code.
C'était bien l'un de mes problèmes, mes plages de saisies sont renseignées en texte, pas par vba, à l'exception des 5 logo "Action spécifiques" qui représentent des rappels d'actions à exécuter au cours d'étapes plus longues.
Il serait donc possible de renseigner tout le document par vba pour éliminer ce détail, mais ta solution est encore mieux !

Si le retrait de la partie "If Target.Column = 1" t'embête, est-il possible de la remplacer par une autre formule désignant un Range plus conséquent? (C3:AF222) pour les planning produit et (D2:AG229) pour les planning semaine.

Je n'arrive d'ailleurs par à faire fonctionner ce système sur ces 2 onglets de planning semaine qui ne sont que des recopie des planning produit en fonction du produit choisi (l'intérêt réside uniquement dans le fait qu'ils soient configurés pour l'impression et dans le bandeau d'en-tête de jour qui contient une formule pour générer un numéro de lot). Je pense que je vais simplement les supprimer et retravailler les onglet de planification pour avoir la même chose...

Dans tous les cas, la prochaine fois que je viens voir mes copains de Toulon, j'espère avoir l'occasion de passer te voir pour te remercier, si tu es bien comme ton pseudo semble l'indiquer, originaire de là bas ^^

 

[patricktoulon]

bonjour varenshar

Si le retrait de la partie "If Target.Column = 1" t'embête, est-il possible de la remplacer par une autre formule désignant un Range plus conséquent? (C3:AF222) pour les planning produit et (D2:AG229) pour les planning semaine.

tu remplace ceci

 If Target.Column = 1 And Target.Count = 1 Then    'si la colonne est la 1 et si il y a qu'une cellule dans target

par cela

If not intersect([C3:AF222],target) is nothing and target.count=1 then

et pour que ça fonctionne sur tes deux feuilles
tu colle le même code dans les deux feuilles

ou

tu le met dans le thisworkbook et tu ajoute une condition pour tes deux feuilles