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

[unparia]

Bonjour
Ton problème est un problème d'arithmétique, avant d'être un problème informatique.
Il serait exactement le même si tu devais mettre dans un rectangle A de certaines dimensions un autre rectangle B
avec d'autres dimensions en voulant à la fois :
- avoir l'image la plus grande possible du rectangle B à l'intérieur du rectangle A
- tout en respectant les proportions du rectangle B
problème de calcul arithmétique, donc. Une fois résolu au niveau arithmétique, la transposition en code sera on ne peut plus simple.
(mais ce forum n'est pas un forum de calcul arithmétique)

[Invité]

Bonjour,
D'abord tu insérer une image, et tu redimensionnes le conteneur de l'image pas l'image.
Comme le dit unparia c'est comme si tu voyais à travers la serrure de la porte!

De plus la taille de l'image est proportionnelle à la cellule pas en proportion largeur hauteur.

Si tu insérais un labels shapps et que tu lui définirasi sa propriété Picture elle s'adapterait automatiquement!

Code :

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

1
2
3
4
5
Set P = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Label.1", Link:=False, _
        DisplayAsIcon:=False, Left:=782.25, Top:=135, Width:=198.75, Height:= _
        136.5)
Set P.Object.Picture = LoadPicture("C:\Users\rdurupt\Desktop\Moi\PionB.gif")
P.Object.Caption = ""

[Linksh]

Merci pour votre aide à tous les 2 !

Cordialement