Discussion :

[Obelix77]

Bonjour,

J'ai récupéré un code VBA qui me permet d'afficher des images dans Excel à partir d'une référence. Quand je tape la référence dans Excel et que j'utilise la fonction :
=AfficheImage(A1&".jpg")
Je récupère l'image jpg ayant le même nom dans le même fichier.

Afin d'être clair, j'ai joint un fichier ".xlsm" et des images.

Je voudrais modifier cette macro :

1) La commande (A1&".pjg") n'est pas simple à taper pour des commerciaux. Il faudrait pouvoir juste montrer la cellule où la référence est tapée.
En clair, je voudrai pouvoir taper juste = AfficheImage(A1)

2) Avec cette fonction, l'image s'adapte à la taille de la cellule. Je voudrai obtenir l'inverse : que la cellule s'adapte à la taille de l'image.

3) Dans l'idéal, il faudrait que la cellule dans laquelle la fonction est tapée se dimensionne automatiquement en fonction d'un critère saisi dans une cellule à coté de la référence :
A1 = référence
B1 = critère portrait ou paysage
C1 = AfficheImage(A1)
Si B1 = portrait, image dans cellule de 135 pixels x 17 pixels dans D1
Si B1 = paysage, image dans cellule de 135 pixels x 34 pixels dans E1

Mais peut être que pour le point 3), je rève .
Si le point 3) est possible, le point 2) devient inutile.

Le problème : je n'y connais rien en VBA. Donc si quelqu'un est intéressé par ma demande; c'est le TOP.
Par avance, merci à tous ceux qui auront pris le temps de lire mon message.

[kiki29]

Salut, sans savoir si cela peut t'aider, regarde et adapte à ton contexte Stocker et visualiser des images GIF dans Excel et Utiliser la librairie Windows Image Acquisition en VBA

[Obelix77]

Merci kiki29 pour ta réponse.
Je connais cette fonctionnalité qui ne répond pas à mon besoin
bonne soirée,

[boisgontierjacques]

Bonsoir,

Une fonction ne peut pas modifier une largeur ou hauteur d'une cellule

Cf PJ

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
 
Private Sub Worksheet_Change(ByVal Target As Range)
 '-- suppression de l'image actuelle
 If Not Intersect([A2:A20], Target) Is Nothing And Target.Count = 1 Then
  For Each s In ActiveSheet.Shapes
      If s.Type = 13 Then
        If s.TopLeftCell.Address = Target.Offset(0, 1).Address Then s.Delete
      End If
   Next s
   If Target <> "" Then
     RépertoirePhoto = "c:\photos\"  ' adapter
     nomimage = Target.Address
     If Dir(RépertoirePhoto & Target & ".jpg") = "" Then
       MsgBox "inconnu"
     Else
      ActiveSheet.Pictures.Insert(RépertoirePhoto & Target & ".jpg").Name = nomimage
      Target.EntireRow.RowHeight = ActiveSheet.Shapes(nomimage).Height
      Target.Offset(, 1).EntireColumn.ColumnWidth = ActiveSheet.Shapes(nomimage).Width / 5.65
      ActiveSheet.Shapes(nomimage).Left = Target.Offset(, 1).Left + 1
      ActiveSheet.Shapes(nomimage).Top = Target.Offset(, 1).Top
     End If
   End If
 End If
End Sub

Jacques Boisgontier

[Obelix77]

Bonsoir Jacques et merci
Que dois taper comme commande pour cette fonction?

J'ai connu, il y a des années (40 ans au moins) un Boisgontier que je voillais au tremblzy su Mauldre. Ca te cause?
Bonne soirée,

Laurent K6