Bonjour,
Je galère depuis hier à modifier une fonction excel personnalisée permettant d'insérer des images.
On spécifie le nom du fichier et le répertoire dans lequel il se situe (ce sont les deux arguments de la fonction), et l'image s'insère. La fonction marche, mais j'aimerais l'améliorer. En l'état la largeur et la longueur de l'image son fixées, mais j'aimerais à la place de spécifier dans le code la taille de l'image, faire en sorte qu'elle se dimensionne en fonction de la cellule (cellules fusionnées). Par exemple, si l'image a un ratio plus long que la cellule, la limite sera la largeur de la cellule et il y aura des bandes blanches en bas et en haut de l'image, et inversement pour un image ayant un ratio moins long que celui de la cellule.
Enfin, j'aimerais pouvoir centrer l'image dans ce deuxième cas (dans le premier cas pas besoin).
Voici le code de la fonction :
J'ai réussi à en faire une version modifiée en remplaçant les vLeft = oRng.Left et vTop = oRng.Top par PictureSizeL = oRng.Width * 3 et PictureSizeH = oRng.Height * 9 mais ça ne marche que dans le cas où l'image a le même ratio que la cellule (fusionnée, d'où le *9 et *3).
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 Option Explicit Function MonLogo( _ ByVal PictureName As String, _ ByVal FolderName As String, _ Optional ByVal PictureSizeH As Long = 160, _ Optional ByVal PictureSizeL As Long = 240, _ Optional ByVal DisplayText As String = "logo >") As Variant Dim oPic As Shape, oRng As Excel.Range Dim vLeft As Variant, vTop As Variant Dim sURL As String Dim sRootURL As String sRootURL = FolderName Set oRng = Application.Caller.Offset(, 0) On Error Resume Next Set oPic = oRng.Parent.Shapes(PictureName) If Err Then Err.Clear vLeft = oRng.Left vTop = oRng.Top Else vLeft = oRng.Left vTop = oRng.Top PictureSizeH = Int(oPic.Height) PictureSizeL = Int(oPic.Width) End If On Error GoTo 0 sURL = sRootURL & PictureName Set oPic = oRng.Parent.Shapes.AddPicture(sURL, msoFalse, True, vLeft, vTop, PictureSizeL, PictureSizeH) oPic.Name = PictureName MonLogo = DisplayText End Function
Merci de votre aide
EDIT : ci-joint le fichier excel pour illustrer mes proposLe fichier comporte en plus une macro qui permet de choisir le dossier dans lequel la fonction d'insertion de l'image vient chercher l'image. Il faut penser à renommer l'image correctement pour que cela fonctionne (ici insertion image.jpg)
insertion image.xlsm
Merci![]()
Partager