Discussion :

[benibeno]

Bonjour,
j'essai de remettre la taille d'origine d'une image qui se trouve dans l'en-tête de WORD.
Je suis capable avec les images qui ne sont pas en-tête.

voici mon code

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
 
Sub Resize()
 Dim oSec As Section
 Dim oHeader As HeaderFooter
 Dim oLogo As InlineShape
 
 
 PercentSize = 100
 
 For Each oSec In ActiveDocument.Sections
 Set oHeader = oSec.Headers(wdHeaderFooterPrimary)
 With oHeader.Range
 Set oLogo = .InlineShapes
 End With
 With oLogo
 .Height = 75
 .Width = 100
 End With
 Next oSec
 
 
 'le bout suivant fonctionne pour les images qui ne sont pas dans l'en-tête
 Dim PecentSize As Integer
 Dim oIshp As InlineShape
 Dim oshp As Shape
 
 PercentSize = 100
 
 
 For Each oIshp In ActiveDocument.InlineShapes
 With oIshp
 .ScaleHeight = PercentSize
 .ScaleWidth = PercentSize
 End With
 Next oIshp
 
 
 For Each oshp In ActiveDocument.Shapes
 With oshp
 .ScaleHeight Factor:=(PercentSize / 100), RelativeToOriginalSize:=msoCTrue
 .ScaleWidth Factor:=(PercentSize / 100), RelativeToOriginalSize:=msoCTrue
 End With
 Next oshp
 
 End Sub

[Invité]

Bonjour,

J'ai essayé de modifier une image dans un contrôle ActiveX image dans le corps d'un document avec votre code, cela ne fonctionne pas. Visiblement, vos objets inlineshape ne doivent pas correspondre au type 5 : wdInlineShapeOLEControlObject.

Plutôt que de tâtonner sur le type d'objet, le mieux serait de mettre en ligne un exemple de document avec les objets que vous manipulez notamment dans l'entête.

[benibeno]

Voici un exemple. J'ai dû enregistré en docx car il passait pas en docm.
testmacroword - Copie.docx

[Invité]

En docm, il faut ziper le fichier.

[benibeno]

ok je saurai pour le futur merci !
Par contre, l'info est quand même présente dans l'autre fichier

[Invité]

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
 
 Sub Resize()
 
 Dim oSec As Section
 Dim oHeader As HeaderFooter
 Dim oLogo As InlineShape, oIshp As InlineShape
 Dim PercentSize As Single
 Dim oshp As Shape
 
     With ActiveDocument
 
          For Each oSec In .Sections
              If oSec.Headers(wdHeaderFooterPrimary).Exists Then
                 Set oHeader = oSec.Headers(wdHeaderFooterPrimary)
                 With oHeader.Range
                      Set oLogo = .InlineShapes(1)
                      With oLogo
                           .ScaleHeight = 75
                           .ScaleWidth = 100
                      End With
                      Set oLogo = Nothing
                 End With
                 Set oHeader = Nothing
              End If
          Next oSec
 
 
         'le bout suivant fonctionne pour les images qui ne sont pas dans l'en-tête
          PercentSize = 100
 
          For Each oIshp In .InlineShapes
              With oIshp
                   .ScaleHeight = PercentSize
                   .ScaleWidth = PercentSize
              End With
          Next oIshp
 
          For Each oshp In .Shapes
              With oshp
                   .ScaleHeight Factor:=(PercentSize / 100), RelativeToOriginalSize:=msoCTrue
                   .ScaleWidth Factor:=(PercentSize / 100), RelativeToOriginalSize:=msoCTrue
              End With
          Next oshp
 
    End With
 
 End Sub

[benibeno]

Merci Éric pour ta réponse.

j'ai une erreur en souligné. On dirait vraiment qu'il ne voit aucune inlishapes dans l'en-tête. Ce code fonctionnait de ton côté ? :

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
Sub Resize()
 
 Dim oSec As Section
 Dim oHeader As HeaderFooter
 Dim oLogo As InlineShape, oIshp As InlineShape
 Dim PercentSize As Single
 Dim oshp As Shape
 
     With ActiveDocument
 
          For Each oSec In .Sections
              If oSec.Headers(wdHeaderFooterPrimary).Exists Then
                 Set oHeader = oSec.Headers(wdHeaderFooterPrimary)
                 With oHeader.Range
                      Set oLogo = .InlineShapes(1)
                      With oLogo
                           .ScaleHeight = 75
                           .ScaleWidth = 100
                      End With
                      Set oLogo = Nothing
                 End With
                 Set oHeader = Nothing
              End If
          Next oSec
 
 
         'le bout suivant fonctionne pour les images qui ne sont pas dans l'en-tête
          PercentSize = 100
 
          For Each oIshp In .InlineShapes
              With oIshp
                   .ScaleHeight = PercentSize
                   .ScaleWidth = PercentSize
              End With
          Next oIshp
 
          For Each oshp In .Shapes
              With oshp
                   .ScaleHeight Factor:=(PercentSize / 100), RelativeToOriginalSize:=msoCTrue
                   .ScaleWidth Factor:=(PercentSize / 100), RelativeToOriginalSize:=msoCTrue
              End With
          Next oshp
 
    End With
 
 End Sub

[Invité]

Ce code fonctionnait de ton côté ? :

Je ne me serais pas permis d'envoyer une solution foireuse.

Sinon, il faut tester le nombre d'inlineshapes :

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
 
Sub Resize()
 
 Dim oSec As Section
 Dim oHeader As HeaderFooter
 Dim oLogo As InlineShape, oIshp As InlineShape
 Dim PercentSize As Single
 Dim oshp As Shape
 
     With ActiveDocument
 
          For Each oSec In .Sections
              If oSec.Headers(wdHeaderFooterPrimary).Exists Then
                 Set oHeader = oSec.Headers(wdHeaderFooterPrimary)
                 With oHeader.Range
                      If .InlineShapes.Count > 0 Then
                         Set oLogo = .InlineShapes(1)
                         With oLogo
                              .ScaleHeight = 75
                              .ScaleWidth = 100
                         End With
                         Set oLogo = Nothing
                      End If
                 End With
                 Set oHeader = Nothing
              End If
          Next oSec
 
 
         'le bout suivant fonctionne pour les images qui ne sont pas dans l'en-tête
          PercentSize = 100
 
          For Each oIshp In .InlineShapes
              With oIshp
                   .ScaleHeight = PercentSize
                   .ScaleWidth = PercentSize
              End With
          Next oIshp
 
          For Each oshp In .Shapes
              With oshp
                   .ScaleHeight Factor:=(PercentSize / 100), RelativeToOriginalSize:=msoCTrue
                   .ScaleWidth Factor:=(PercentSize / 100), RelativeToOriginalSize:=msoCTrue
              End With
          Next oshp
 
    End With
 
 End Sub