Discussion :

[Linksh]

Bonjour,

J'ai trouvé en cherchant sur le web, une macro VBA permettant après un double click sur une cellule, d'insérer une image et de la redimensionner à la taille de la cellule en respectantses proportions.
Je suis sur Excel 2013. Cette cellule est une cellule fusionnée.

Cela fonctionne pour la plupart des images mais bizarrement cela ne fonctionne pas pour certaine : . Et j'ai remarqué qu'il s'agit souvent de photo (notamment celles prises avec l'ordinateur ou une appareil photo) mais pas que.
Le problème de dimensionnement se situe uniquement sur la largeur de l'image. Quand je fais afficher les dimensions de l'image que la macro récupère la largeur est fausse tandis que la hauteur est bonne !

Savez vous comment résoudre ça ?

Merci beaucoup

1er code pour lancer l'insertion

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim picToOpen As String
 
If Not Application.Intersect(Target, Range("A1")) Is Nothing Then
ScreenUpdating = False
picToOpen = Application.GetOpenFilename("Pics (*.jpg;*.gif;*.png;*.jpeg), *.jpg;*.gif;*.png;*.jpeg")
InsertPictureInRange picToOpen, Selection
End If
 
End Sub

2nd code pour redimensionner l'image

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
 
Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
' inserts a picture and resizes it to fit the TargetCells range
Dim p As Object
Dim t, l, w, h As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
' determine positions
With TargetCells
t = .Top
l = .Left
w = .Width
h = .Height
End With
' position picture
With p
.Top = t
.Left = l
.Width = w
.Height = h
End With
Set p = Nothing
End Sub