Mettre une image dans une cellule

Bonjour à tous.

Je cherche à faire menu déroulant qui irait chercher des images sur une seconde feuille. C'est pour gérer des transferts sur un petit jeu en ligne sur téléphone mais je m'acharne dessus depuis 2 jours sans y arriver. Avec VBA, sans VBA ... J'ai même fait des recherches via IA mais rien de correct, j'ai trouvé une solution sur Youtube en nommant les images mais pareil, ça ne fonctionne pas toujours. Parfois l'image s'affiche, parfois non ... et je n'arrive jamais à centrer cette fameuse image. Un casse tête sans fin. Pouvez-vous m'aider svp. Merci.

Bonsoir,

Voir exemple si cela peut te convenir 🤔

Slts

Magnifique, c'est exactement ce dont j'avais besoin. Du coup, tu as renommé les images ? J'ai vu dans le gestionnaire des noms une modification et un peu de VBA ? C'est ça ? Je demande pour apprendre et me coucher un peu moins bête ce soir. Merci beaucoup.

Bonjour,

Oui j'ai renommé les images, après cela ne t'empêche pas de les renommer selon ton choix

Dans le gestionnaire de noms j'ai crée un nouveau nom (Liste) avec la formule suivante

=DECALER(FC!$A$2;;;NBVAL(FC!$A:$A)-1)

Puis dans les validations de données pour la liste déroulante j'ai mis =Liste

En ce qui concerne les macros dans la feuille même (Transfères) j'ai mis ce code VBA

Private Const colonne As Long = 4 
Private Sub Worksheet_Change(ByVal Target As Range)
  Set images = Sheets("FC")
  If Target.Column = colonne And Target.Count = 1 Then
    '-- suppression
    For Each s In ActiveSheet.Shapes
      If s.Type = 13 Then
        If s.TopLeftCell.Address = Target.Address Then s.Delete
      End If
    Next s
    If Target <> "" Then
      On Error Resume Next
      images.Shapes(Target).Copy
      If Err = 0 Then
        ActiveSheet.Paste
        Selection.OnAction = "ClicImage"
        Selection.Name = "Image" & ActiveCell.Row
        PlaceTheShapeInCenterRange Target, ActiveSheet.Shapes("Image" & ActiveCell.Row), 10 '10% de réduction
        Target.Select
      End If
    End If
   End If
End Sub

Sub PlaceTheShapeInCenterRange(rng As Range, shap, Optional marge As Long = 0)     'la marge exprime un pourcentage de 1 à x%
    Dim Ratio#
    Ratio = Application.Min(rng.Cells(1).MergeArea.Width / shap.Width, rng.Cells(1).MergeArea.Height / shap.Height)
    With shap
        .LockAspectRatio = True
        .Width = .Width * (Ratio * ((100 - marge) / 100))
        .Top = rng.Top + ((rng.Cells(1).MergeArea.Height - .Height) / 2)
        .Left = rng.Left + ((rng.Cells(1).MergeArea.Width - .Width) / 2)
    End With
End Sub

Et dans un nouveau Module4 j'ai mis ce code

Public colonne As Long

Sub ClicImage()
    With ActiveSheet.Shapes(Application.Caller).TopLeftCell
        colonne = .Column
        .Select
        CreateObject("Wscript.shell").SendKeys "%{down}"
    End With
End Sub

Voilà ce que j'ai fait

Slts

Ok, merci beaucoup. J'avais déjà un peu fouillé dans le code mais je n'avais pas tout vu. Problème réglé, encore merci.

Bonjour le fil, Joe57,

C'est pour gérer des transferts sur un petit jeu en ligne sur téléphone mais je m'acharne dessus depuis 2 jours sans y arriver

Là me viens une question, VBA en ligne sur un téléphone ?