1 pièce(s) jointe(s)
Bug fonction d'import d'image
Bonjour à tous,
J'ai créé la fonction personnalisé suivante :
Code:
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
| Function Image_test( _
ByVal PictureName As String, _
ByVal FolderName As String) As Variant
Dim CellLoc As Excel.Range
Dim p As Picture
Dim ImagePath As String
Set CellLoc = Application.Caller.Offset(, 0)
ImagePath = FolderName & PictureName
Set p = CellLoc.Parent.Pictures.Insert(ImagePath)
p.Left = CellLoc.MergeArea.Left
p.Top = CellLoc.MergeArea.Top
If p.Width > CellLoc.MergeArea.Width Then p.Width = CellLoc.MergeArea.Width
If p.Height > CellLoc.MergeArea.Height Then p.Height = CellLoc.MergeArea.Height
'Center
If p.Width < CellLoc.MergeArea.Width Then p.Left = CellLoc.MergeArea.Left + (CellLoc.MergeArea.Width - p.Width) / 2
If p.Height < CellLoc.MergeArea.Height Then p.Top = CellLoc.MergeArea.Top + (CellLoc.MergeArea.Height - p.Height) / 2
End Function |
Cette fonction est sensée insérée une image dans la cellule où elle se trouve, et adapter l'image sans la déformer à la cellule.
Cette fonction fonctionne plutôt bien , mais il arrive des fois que l'image soit un peu trop grande et pas totalement dans la case (elle est décalée). Cela arrive surtout quand la fonction est combinée à une macro de sélection de dossier qui écrit le chemin de l'image à insérer dans la case "répertoire", d'où le "FolderName" dans la fonction.
J'ajoute un fichier d'exemple pour illustrer mon problème : pour faire fonctionner l'import,d'image, créer une photo test.jpg, puis cliquer sur le bouton "choisir..."; et sélectionner le dossier dans lequel se trouve test.jpg.
Normalement l'image s'insère dans la case, mais il arrive qu'elle soit décalée, il faut alors supprimer l'image insérée puis re-valider la formule de cellule.
Pièce jointe 283858
Malgré mes efforts je ne vois pas pourquoi cela bug parfois, avez vous des idées ?
Merci :)
