Discussion :

[simpson25]

Bonjour la communauté

J'ai un projet : faire une macro dans Word 365 qui va transformer touts les groupes de formes en image dans un document.
Toutes les groupes de formes ont été renommés (de 1 à x). Dans mon exemple il y a 4 groupes à transformer en image. EssaiMacroImageForme.7z

J'ai réalisé l'enregistrement d'une macro pour voir à quoi ressemblerait le code en faisant un couper collage spéciale image :

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 macorManuelle2()
' macorManuelle2 Macro
 
    ActiveDocument.Shapes.Range(Array("1")).Select
    Selection.Cut
    Selection.PasteSpecial Link:=False, DataType:=15, Placement:=wdInLine, _
        DisplayAsIcon:=False
 
    ActiveDocument.Shapes.Range(Array("2")).Select
    Selection.Cut
    Selection.PasteSpecial Link:=False, DataType:=15, Placement:=wdInLine, _
        DisplayAsIcon:=False
 
    ActiveDocument.Shapes.Range(Array("3")).Select
    Selection.Cut
    Selection.PasteSpecial Link:=False, DataType:=15, Placement:=wdInLine, _
        DisplayAsIcon:=False
 
    ActiveDocument.Shapes.Range(Array("4")).Select
    Selection.Cut
    Selection.PasteSpecial Link:=False, DataType:=15, Placement:=wdInLine, _
        DisplayAsIcon:=False
End Sub

Elle marche malgré quelques petits problèmes de mise en page mais je verrai ceci dans un second temps.

J'ai donc réalisé un code avec une boucle. Et pour savoir le nombre de formes présentes, je demande à l'utilisateur via une inputbox

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 MacroCopierCollerImage()
'
' MacroCopierCollerImage Macro
'
Dim i As Integer, a As Integer ' a pour le nombre maximum de groupes de formes dans le word
 
a = InputBox("veuillez saisir le nombre de groupes d'images du documnent") 'version simplifié
 
For i = 1 To a
 
    ActiveDocument.Shapes.Range(Array(i)).Select
    Selection.Copy
    Selection.Cut
    Selection.PasteSpecial Link:=False, DataType:=15, Placement:=wdInLine, _
        DisplayAsIcon:=False
 
 
    Next
 
End Sub

Cette macro ne marche pas. Je la lance au pas à pas et les erreurs ne sont pas toujours les memes :
- Parfois la macro commence par transformer le groupe 3 en 1er, parfois c'est le groupe 4 en 1er mais jamais le groupe 1 (alors qu'avec l'espion j'ai bien i=1
- Parfois l’erreur est au niveau du collage spéciale qui ne marche pas au 2eme groupe
- Parfois l’erreur est « l’index de cette collection est en dehors des limites, à la 3eme image.

Ma question est : pourquoi la macro ne commence pas par mon groupe n°1 et le fait dans l'ordre numérique (1,2,3,4)

C'est ma 1ere macro sous word et je n'ai jamais été un professionnel de VBA, est ce que j'ai loupé quelque chose d'évident?
Merci pour votre aide

[E KERGRESSE]

Bonjour,

Comme vous modifiez l'indexation de la collection Shapes, il vous faut commencer par la fin.
En revanche, je n'ai pas réussi à modifier les noms des InlineShapes après transformation.

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
 
Sub MacroCopierCollerImage()
 
Dim I As Integer
 
    With ActiveDocument
        For I = .Shapes.Count To 1 Step -1
            .Shapes(I).Select
            With Selection
                 .Copy
                 .Cut
                 .PasteSpecial Link:=False, DataType:=15, Placement:=wdInLine, DisplayAsIcon:=False
            End With
        Next I
     End With
 
End Sub

[simpson25]

Un grand merci pour ce retour rapide! Ça répond parfaitement à ce dont j'avais besoin en beaucoup mieux optimisé.
C'est pour un transfert vers un autre logiciel, donc pas de besoin de renommer les inlineshapes.
Bonne journée

Bonjour,

Comme vous modifiez l'indexation de la collection Shapes, il vous faut commencer par la fin.
En revanche, je n'ai pas réussi à modifier les noms des InlineShapes après transformation.

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
 
Sub MacroCopierCollerImage()
 
Dim I As Integer
 
    With ActiveDocument
        For I = .Shapes.Count To 1 Step -1
            .Shapes(I).Select
            With Selection
                 .Copy
                 .Cut
                 .PasteSpecial Link:=False, DataType:=15, Placement:=wdInLine, DisplayAsIcon:=False
            End With
        Next I
     End With
 
End Sub