Bonjours, je désire créer une Macro pour redimensionner une image en gardant ses proportion. Pour cela j'utilise la fonction iPict afin de connaitre sa taille (Height & Width) en CM.
Puis je fait un calcul pour savoir par combien je doit multiplier mon image pour obtenir la taille voulut et je la redimensionne.
Pour faire cela j'utilise le code suivant:

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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
 
Sub DimensionsImage()
  'Fonctionne pour les formats: JPG, jpeg, gif, bmp
 
'Recupere la taille d'un image sur le disque dur
 
    Dim iPict As IPictureDisp
    Dim NomFichier As String
 
    Chemin = Application.GetOpenFilename(, , "Choisissez le LOGO")
 
 If Chemin <> False Then
            Else
            Exit Sub
        End If
 
    Set iPict = LoadPicture(Chemin)
    Largeur = Round((iPict.Width) / 1000, 2)
    Hauteur = Round((iPict.Height) / 1000, 2)
 
'MsgBox "Largeur:" & Largeur & " Hauteur:" & Hauteur
 
'Calcul le % par rapport a la taille voulut et garde le plus petit puis effectue la modification sur l'image
 
 
 
    If (8.48 / Largeur) < (5.31 / Hauteur) Then
        Pourcentage = (8.48 / Largeur)
        Info = "Largeur"
        Else
            Pourcentage = (5.31 / Hauteur)
            Info = "Hauteur"
    End If
 
 
'MsgBox Pourcentage & Info
 
' Insert et redimentionne l'image
 
    Range("S16").Select
    ActiveSheet.Pictures.Insert(Chemin).Select
    Selection.ShapeRange.ScaleHeight Pourcentage, msoFalse, msoScaleFromTopLeft
 
' Centre l'image
    If Info = "Largeur" Then
        Decallage = ((5.31 - (Hauteur * Pourcentage)) / 2) * 28.35
        Selection.ShapeRange.IncrementTop Decallage
        Else
            Decallage = ((8.48 - (Largeur * Pourcentage)) / 2) * 28.35
            Selection.ShapeRange.IncrementLeft Decallage
    End If
 
End Sub
1) Le problème survient lors se que je sélectionne des images d'une définition différente de 96ppp. La fonction iPict ne me retourne plus la bonne valeur.
2) Le problème se pose aussi si je sélectionne une image trop grande car au moment de l'insertion de l’image sur excel celle ci est automatiquement redimensionner. La ligne de code (42) qui retaille mon image est donc erroné car elle fonctionne uniquement pour une image a 100% de sa taille.

Je cherche donc:
1)Une fonction pour me donner la définition de l'image ou autre solution.
2)A empêcher le redimensionnement de l'image lors de son insertion.

Merci de votre lecture et attention.
PS: Désolé pour l’orthographe.