Discussion :

[doudoustephane]

Bonjour à tous.
Alors voilà mon problème, j'ai un client qui m'a fourni toute une série de photo de taille (dimension) différente. Je dois les insérer dans Excel en les redimensionnant en 2.5x1.67 maxi (2.5 obligatoire, 1.67 variable en fonction de la proportionnalité) et je n'y parviens pas.
Actuellement, j'insère les images avec la librairie WIA et la commande Shapes.AddPicture bien que cela ne me satisfait à cause de la librairie à déployer avec le fichier Excel.
Donc, si vous pouviez m'aider sur cette histoire de taille et éventuellement sur comment insérer les images redimensionnées sans passer par la librairie...
Merci d'avance à tous
Cordialement
doudouallemand

[ouskel'n'or]

tout dépend de la méthode utilisée pour insérer les images. Si elles sont insérées dans des contrôles "image", tu as la propriété PictureSizeMode qui permet d'avoir une image non déformée quelque soit les dimension du conteneur.

Code :

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

1
2
3
4
5
Sub test()
ActiveSheet.Image1.Height = 100
ActiveSheet.Image1.Width = 100
ActiveSheet.Image1.PictureSizeMode = 3 'correspond à fmPictureSizeModeZoom
End Sub

Si l'image est insérée directement, tu peux la redimensionner en modifiant son échelle

Code :

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

1
2
3
4
5
6
7
8
Sub test()
Dim Limage As Shape
    For Each Limage In ActiveSheet.Shapes
        Limage.Select
        Selection.ShapeRange.ScaleWidth 0.57, msoFalse, msoScaleFromMiddle
        Selection.ShapeRange.ScaleHeight 0.57, msoFalse, msoScaleFromMiddle
    Next
End Sub

Tu précises tes besoins
A+

[doudoustephane]

En fait, c'est pour des images que j'insère directement.
Je viens de regarder ta deuxième solution mais, comment trouver le bon ratio pour chaque image dans ce cas là ?
Merci à toi

[ouskel'n'or]

Si tu peux donner une hauteur commune à toutes tes images, tu calcule une échelle commune

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test()
Dim Limage As Shape, NewH as integer, NewL as integer
Dim Hauteur as integer, Largeur as integer
    For Each Limage In ActiveSheet.Shapes
        Limage.Select
        Hauteur = Selection.ShapeRange.Height
        Largeur = Selection.ShapeRange.Width
        NewH = 200
        NewL = Int(Largeur * (NewH / Hauteur))
        Selection.ShapeRange.LockAspectRatio = msoTrue
        Selection.ShapeRange.Height = NewH
        Selection.ShapeRange.Width = NewL
    Next
End Sub

Si c'est une largeur commune que tu veux, tu inverses
A+

[doudoustephane]

OK, merci.
Dernière question : comment savoir combien de pixels (puisque tes valeurs indiquées sont en pixels) font 2.5 cm et 1.67 cm ?
Merci

[ucfoutu]

Bonjour,

On compte 567 twips par centimetre "logique"

Le reste (calcul du nombre de pixels par rapport au nombre de twips) dépend directement de la résolution de l'écran.

[doudoustephane]

D'accord, merci à tous les deux pour ces réponses.
Je passe le sujet en
doudouallemand