Discussion :

[iBenny]

Bonjour,

J'essaie d'ouvrir la fenêtre de "Format de l'image" et dans l'onglet "Taille"

1. décocher la case des proportions hauteur/largeur
2. copier le champ "Largeur" sous "Échelle"
3. coller dans le champ "Hauteur"

et mon code n'arrive même pas à ouvrir la fenêtre ! Ça cloche où d'après vous ?

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 Recadrer()
  Tasks("Word").Activate
  pause
  If Selection.Type <> wdSelectionShape Then Exit Sub
  Sendkeys "%t", True
  Sendkeys "g", True
  Sendkeys "{LEFT 2}", True
  Sendkeys "{TAB 6}{SPACE}", True
  Sendkeys "+{TAB 2}", True
  Sendkeys "^C", True
  Sendkeys "+{TAB}", True
  Sendkeys "^V", True
  Sendkeys "~", True
End Sub

Merci à l'avance de vos lumières,
iBenny

[mromain]

Bonjour iBenny, le forum,

Dans la mesure du possible, il faut éviter les SendKeys.
Tu trouveras ci-dessous un exemple montrant comment réaliser ces deux actions sur les formes sélectionnées, qu'elles soient de type Shape ou InlineShape :

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
Sub Test()
Dim l_o_shp         As Word.Shape
Dim l_o_inlineShp   As Word.InlineShape
Dim l_d_ratio       As Double
 
    'boucler sur toutes les formes (de type "Avec habillage du texte") sélectionnées
    For Each l_o_shp In Application.Selection.ShapeRange
        'désactiver la proportion hauteur/largeur
        l_o_shp.LockAspectRatio = False
        'définir le % de heuteur (= au % de largeur)
        l_d_ratio = l_o_shp.Width
        l_o_shp.ScaleHeight 1, True
        l_o_shp.ScaleWidth 1, True
        l_d_ratio = l_d_ratio / l_o_shp.Width
        l_o_shp.Width = l_o_shp.Width * l_d_ratio
        l_o_shp.Height = l_o_shp.Height * l_d_ratio
    Next l_o_shp
 
    'boucler sur toutes les formes (de type "Alligné sur le texte") sélectionnées
    For Each l_o_inlineShp In Application.Selection.InlineShapes
        'désactiver la proportion hauteur/largeur
        l_o_inlineShp.LockAspectRatio = False
        'définir le % de heuteur (= au % de largeur)
        l_o_inlineShp.ScaleHeight = l_o_inlineShp.ScaleWidth
    Next l_o_inlineShp
 
    Set l_o_shp = Nothing
    Set l_o_inlineShp = Nothing
End Sub

A+

[iBenny]

mromain ,

pas mal compliqué votre solution !

J'avais commencé à effectuer mes modif en utilisant l'enregistreur de macro. La procédure générée contenait l'ensemble des paramètres de la fenêtre "Format de l'image" SAUF... les champs qui m'intéressent : Hauteur/Largeur d'échelle !? Est-ce pareil chez vous ?

Je simplifie votre proposition car je n'ai pas besoin de boucler sur toutes les formes et pas besoin de mod les formes "inline". Seulement sur l'image sélectionnée :

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
Sub Test()
Dim img As Word.Shape
Dim rap As Double
 
  Tasks("Word").Activate
  pause
  If Selection.Type <> wdSelectionShape Then Exit Sub
 
  set img = selection
 
  img.LockAspectRatio = False
 
  rap = img.Width
  img.ScaleHeight 1, True
  img.ScaleWidth 1, True
  rap = rap / img.Width
  img.Width = img.Width * rap
  img.Height = img.Height * rap
 
  Set img = Nothing
 End Sub

et... en étudiant votre code, on constate une erreur de logique:

rap = img.Width
rap = rap / img.Width

ce qui reviens à dire :

rap = img.Width / img.Width = 1

OUPPPS ! C'est moi maintenant qui interprète mal votre code . C'est bon...

Salutations cordiales,
iBenny

[mromain]

Rebonjour,

en étudiant votre code, on constate une erreur de logique:

rap = img.Width
rap = rap / img.Width

ce qui reviens à dire :

rap = img.Width / img.Width = 1

En fait, entre rap = img.Width et rap = rap / img.Width, on fait un img.ScaleWidth 1, True (ce qui modifie le img.Width).

On rétablie ensuite le img.Width original avec img.Width = img.Width * rap.

C'est une bidouille pour "définir le % de hauteur = au % de largeur".

L'important est que tu aies trouvé ton bonheur !

A+

[iBenny]

En effet mromain, d'où mon "OUPPPS" dans mon message précédent...

Mon code final sera donc :

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
Sub Recadrer()
'
' Recadrer Macro
' Macro enregistrée le 2024-03-10 par Benoît
'
Dim rap As Double
 
     Tasks("Word").Activate
     pause
     If Selection.Type <> wdSelectionShape Then Exit Sub
 
With Selection.ShapeRange
     .LockAspectRatio = msoFalse
      rap = .Width
     .ScaleWidth 1, , msoScaleFromBottomRight
     .ScaleHeight 1, , msoScaleFromBottomRight
      rap = rap / .Width
     .Height = .Height * rap
     .Width = .Width * rap
     .LockAspectRatio = msoTrue
End With
 
End Sub

Salutations cordiales,
iBenny