Macro redimensionner photos Fermé

Question

Bonjour,

Je souhaiterais un peu d'aide pour créer une macro afin de redimensionner des photos intégrés dans un document word.
Sachant qu'il y a des photos au format portrait et paysage, je voudrait pouvoir les réduire à 40% en gardant les proportions identiques.

Merci d'avance de votre aide.

Loic

C-Claire · Accepted Answer

Bonjour,

si tes photos sont alignées sur le texte, tu peux utiliser la macro suivante :

Sub modifier_taille_image()
R = InputBox("Indiquez le pourcentage de réduction voulu :")
For I = 1 To ActiveDocument.InlineShapes.Count
    ActiveDocument.InlineShapes(I).ScaleHeight = R
    ActiveDocument.InlineShapes(I).ScaleWidth = R
Next
End Sub

Yoic · Answer

Merci. Ça fonctionne nikel.
Juste une petite subtilité.
Comment fait on pour que la macro ne redimensionne que les images sélectionnés et pas toutes les images contenues dans le document ?
J'ai des logos au format jpeg également présent dans le document que je ne souhaite pas redimensionner.

m@rina · Answer

Bonsoir,

Tu dis "les images sélectionnées"... Si tes images n'ont pas d'habillage, tu ne pourras en sélectionner qu'une seule à la fois, me semble-t-il. Es tu certain que tes images n'ont jamais d'habillage ?
Dans Word, et donc dans le VBA de Word, on distingue les images avec et sans habillage. Les images sans habillage sont des images alignées sur le texte, ce sont des InlineShapes, celles avec habillage sont des Shapes.
Elles ne se traitent pas de la même manière.

m@rina

C-Claire · Answer

Je rebondis sur la réponse de m@rina à propos des images alignées sur le texte ou non.
Voici une petite macro qui te permettra déjà de savoir combien tu as d'images "InlineShapes" et combien "Shapes".
Tu peux juste l'exécuter sans l'enregistrer le temps de voir le résultat.

Sub Quel_Type_Image()
Dim i As Integer
If Not IsNull(ActiveDocument.InlineShapes.Count) Then
    i = ActiveDocument.InlineShapes.Count
    MsgBox "Il y a " & i & " images alignées sur le texte (InlineShapes)."
End If
If Not IsNull(ActiveDocument.Shapes.Count) Then
    i = ActiveDocument.Shapes.Count
    MsgBox "Il y a " & ActiveDocument.Shapes.Count & " images habillées (Shapes)."
End If
End Sub

Macro redimensionner photos

4 réponses

Discussions similaires