Discussion :

[karakz]

je veux inserer une image dans un cellule du tableau.
je peux pas (peut etre un probleme de macros non signés) de tte façon g activé toutes les macros. mais rien a faire
l'insertion est toujours impossible et les boutons pour linsertion sont tjrs desactivé ( je ne peux pas cliquer dessus)

[wilfried_42]

bonjour

si ça t'intéresse, avec une formule, qui fait appelle à une fonction personalisé
Fonction à placer dans un module standard

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Function Image(img_nom As Variant, Optional chemin As String = "") As String
    ' Declaration des variables
    Dim ref As Range, sh As Shape, drap As Boolean
    ' ref : la cellule qui provoque la fonction
    ' sh : les shapes
    ' Drap : drapeau definissant si la shape est trouvée
    Application.Volatile ' defini une fonction qui se recalcule automatiquement
' teste le type de variable soit une cellule soit une valeur alphanumerique
    Select Case TypeName(img_nom)
        Case "Range" ' c'est une reference cellule
            Image = img_nom.Value
        Case "String" ' c'est une valeur alphanumerique
            Image = img_nom
        Case Else ' c'est une erreur
            Image = "#ERROR"
            Exit Function
    End Select
' le chemin est un parametre optionnel, s'il est omis, la valeur est le chemin du classeur
    If chemin = "" Then chemin = ThisWorkbook.Path
' le chemin ne se termine pas forcemment par \ je le rajoute
    If Right(chemin, 1) <> "\" Then chemin = chemin & "\"
    Set ref = Application.Caller ' affectaction à ref de la cellule qui lance la fonction
    If ref.MergeCells = True Then Set ref = Range(ref.MergeArea.Address)
    drap = False ' initialisation du drapeau
    For Each sh In ref.Worksheet.Shapes ' je passe en revue toute les shapes
' je teste son nom construite plus bas pour savoir si c'est la bonne shappe
        If "Img-" & ref.Address = Left(sh.Name, Len(ref.Address) + 4) Then drap = True: Exit For
    Next
    If drap = True Then ' c'est la bonne shape
' je teste maintenant si c'est la meme que celle de la formule pour ne pas refaire le traitement
' Le gain de temps n'est pas negligeable
       If "Img-" & ref.Address & "-" & Image = sh.Name Then GoTo fin ' egalité parfaite, je sors
    End If
    On Error Resume Next ' controle d'erreur, si la shape n'existe pas encore, l'instruction suivante provoque une erreur
    sh.Delete ' je detruits la shap
    If Image = "" Then Exit Function ' la valeur est à "" alors pas de shape à affecter
' j'inserre la shape, avec l'image en lui mettant les tailles necessaires pour la cellule
    Set sh = ref.Worksheet.Shapes.AddPicture(chemin & Image, True, True, ref.Left, ref.Top, ref.Width, ref.Height)
    sh.Name = "Img-" & ref.Address & "-" & Image ' je definis son nom pour la trouver plus tard
fin:
    Image = "Img" & ref.Address ' j'affecte un nom pour resultat
End Function

Formule à placer dans la cellule
l'image est dans le répertoire du classeur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=Image("Nom de l'image.jpg")

l'image n'est pas dans le répertoire du classeur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=Image("Nom de l'image.jpg";"Chemin de l'image")

la taille de l'image s'adapte à la taille de la cellule même fusionée

[johanaquatique]

Parfait cette solution, dans mon cas je souhaiterai qu'il y ai un AUTOADJUST de l'image par apport à la taille de la cellule avec un zoom proportionnel. et dexième chose très intéressante c'est qu'il serait bien qu'on tape par exemple une rérérence en cellule A1 "502657" et hop il y a l'image "502657.jpg" qui s'alffiche en B2 !

Possible ?

Merci
Johan

[wilfried_42]

re:

pour la formule :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=Image(A1 & ".jpg")

pour le reste de la question, je n'ai pas tout compris
l'image s'ajuste selon la taille de la cellule mais si tu changes la taille après, il faut supprimer l'image pour le ré-affichage.

[johanaquatique]

ok ben ce que je veux dire pour l'auto ajustement de la photo, c'est que "oui" elle s'adapte bien à la cellule, mais elle ne garde pas la bonne proportion de taille. et j'aimerai qu'elle soit centrée plutôt que en format "top" : que faire ?
Merci en tout cas
Johan

[johanaquatique]

bonjour, la formule c'est ok pour les recherches des photos en fonction d'une référence produit (merci ), cela fonctionne super.

Par contre, pour l'ajustement à la cellule, je met un print screen (voir ligne N°6) de mon résultat, pourquoi la photo ne s'ajuste pas en largueur ?

J'aimerai beaucoup si ce n'est pas trop demander, avoir un bouton en haut de page pour actualiser toutes les photos liées pour les mises à jour de photos.

et pour finir, j'ai 3 images par produit ! mais pas toujours (des fois une, des fois deux, et des fois trois !) comments faire pour ne pas afficher d'erreur si "pas dismage dispo dans le dossier lié"

PS: pour info : j'utilise cette formule

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=Image(A5 & ".jpg";"Chemin de l'image")

et là c'est le top du top si j'ai réponse à tout cela !
bonne sacré journée à tous

[wilfried_42]

bonjour

pour un soucis de rapidité, la formule ne ré-affiche pas une image ayant la même référence, la ligne concernée est celle-ci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
    If drap = True Then ' c'est la bonne shape
       If "Img-" & ref.Address & "-" & Image = sh.Name Then GoTo fin
    End If

lignes à supprimer (si j'ai tout compris)

[johanaquatique]

bonjour,

Non en fait je m'exprime mal

J'ai 3 besoins !

1 : Comme mon print screen je voudrais que l'image s'ajuste en auteur et en largueur par apport à la taille de la cellule concernée (garder les bonnes proportions)

2 : Pour actualiser les images ton code est parfait évidement surtout il ne faut pas changer c'est bien que pour la rapidité il garde la "non actualisation" MAIS, ce que je cherche à faire, c'est d'avoir un bouton de commande qui lorsque "clic" il actualiser toutes les images en fonction des ref, et selement si "clic" ? possible de me dire le code ?

3 : j'ai 3 images par ref (mais pas tout le temps) comment ne pas afficher l'erreur dans la cellule image si aucune image n'est dispo ? code ?

Voici mon besoin, merci pour l'intérêt
Bonne journée

Johan

[Invité]

Bonjour,

Adapte la hauteur de l'image à la hauteur de la cellule et respecte les proportions.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 
Function AfficheImage(NomImage, rep)
  Application.Volatile
  Set adr = Application.Caller
  temp = NomImage & "_" & adr.Address
  Existe = False
  For Each s In adr.Worksheet.Shapes
    If s.Name = temp Then Existe = True
  Next s
  If Not Existe Then
     For Each k In adr.Worksheet.Shapes
        p = InStr(k.Name, "_")
        If Mid(k.Name, p + 1) = adr.Address Then k.Delete
     Next k
     If Dir(rep & NomImage) = "" Then
        AfficheImage = "Inconnu"
     Else
       Set myShell = CreateObject("Shell.Application")
       Set myFolder = myShell.Namespace(rep)
       Set myFile = myFolder.Items.Item(NomImage)
       Taille = myFolder.GetDetailsOf(myFile, 26)
       H = Val(Split(Taille, "x")(1))
       L = Val(Split(Taille, "x")(0))
       Ech = adr.Height / H
       H = H * Ech
       L = L * Ech
       Set s = adr.Worksheet.Shapes.AddPicture(rep & NomImage, True, True, adr.Left, adr.Top, L, H)
       s.Name = NomImage & "_" & adr.Address
       AfficheImage = "ok"
    End If
  End If
End Function

JB

[johanaquatique]

Merci, mais je ne comprend pas où dois-je mettre le code ? je ne trouve pas mes remères, une explication est possible ?
Merci d'avance

[johanaquatique]

bonjour, ok là j'ai dormi
ok j'ai mis dans un module et j'appel sans ma cellule ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=AfficheImage(A7&".jpg";"\\MonCheminReseau\IMAGE_PHOTOTHEQUE")

Mais cela n'affiche pas mes images lorsque je tape les ref en colonne 1 !

Il y a quelque chose d'autre à changer ?
Merci

[Invité]

Voir PJ

JB

[johanaquatique]

hello, merci , vais regarder cela de plus près !

[johanaquatique]

J'ai utilisé ce code sur la celule, mais il n'affiche plus la photo PQ ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=afficheimage2(A2&".jpg";"C:\mondossier\")