Discussion :

[Quentin987]

Bonjour,

Je cherche à monter un scripte vba pour power point, qui me répète une mise en page, de page en page. Je veux identifier les différentes images, les redimensionner et les positionner en plusieurs points de ma diapo. Indication importante, toutes les diapo ne contiennent pas forcement 6 images. Je souhaiterai alors laisser les derniers emplacements vide.

J’ai une macro qui marche pour un slide unique :

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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
 
Sub miseenpage()
    Dim shp As Shape
    Dim sld As Slide
 
    Set sld = ActivePresentation.Windows(1).View.Slide
       ' on boucle sur la collection des shapes
        For Each shp In sld.Shapes
            ' on test si c'est une shape de type image
            If shp.Type = msoPicture Then
                With shp
                   '.Left = 10
                   '.Top = 10
                    .Width = 300
                    .Height = 220
                End With
            End If
        Next shp
 
 
    On Error GoTo Suite
 
        Set shp = sld.Shapes(1)
            With shp
                .Left = 10
                .Top = 20
            End With
 
        Set shp = sld.Shapes(2)
            With shp
                .Left = 310
                .Top = 20
            End With
 
 
         Set shp = sld.Shapes(3)
            With shp
                .Left = 620
                .Top = 20
            End With
 
 
         Set shp = sld.Shapes(4)
            With shp
                .Left = 10
                .Top = 300
            End With
 
 
         Set shp = sld.Shapes(5)
            With shp
                .Left = 310
                .Top = 300
            End With
 
         Set shp = sld.Shapes(6)
            With shp
                .Left = 620
                .Top = 300
            End With
 
Suite:
 
End Sub

Quand j’essaie de la généraliser à l’intégralité du document :

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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
 
 
Sub miseenpage()
    Dim shp As Shape
    Dim sld As Slide
 
    ' on boucle sur la collection des diapositives
    For Each sld In Application.ActivePresentation.Slides
       ' on boucle sur la collection des shapes
        For Each shp In sld.Shapes
            ' on test si c'est une shape de type image
            If shp.Type = msoPicture Then
                With shp
                   '.Left = 10
                   '.Top = 10
                    .Width = 300
                    .Height = 220
                End With
            End If
        Next shp
 
 
 
 
    On Error GoTo Suite
 
        Set shp = sld.Shapes(1)
            With shp
                .Left = 10
                .Top = 20
            End With
 
        Set shp = sld.Shapes(2)
            With shp
                .Left = 310
                .Top = 20
            End With
 
 
         Set shp = sld.Shapes(3)
            With shp
                .Left = 620
                .Top = 20
            End With
 
 
         Set shp = sld.Shapes(4)
            With shp
                .Left = 10
                .Top = 300
            End With
 
 
         Set shp = sld.Shapes(5)
            With shp
                .Left = 310
                .Top = 300
            End With
 
         Set shp = sld.Shapes(6)
            With shp
                .Left = 620
                .Top = 300
            End With
 
Suite:
 
    Next sld
 
End Sub

Ça me donne un message d’erreur, me disant que l’indice 2 n’existe pas pour sld.Shapes(), comme si le On Error GoTo Suite n’avait effet qu’au 1er passage.
Voyez-vous où mon code est défaillant ? Serait-il possible d’exclure des diapo (par exemple 1, 3 et7) de la boucle For Each sld In Application.ActivePresentation.Slides ?

Une autre question : Comment sauvegardez-vous vos Macro ? Pour l’instant j’utilise un système précaire de copier-coller dans un document texte, mais il y a probablement plus intelligent.
Merci d’avance pour votre aide.

Quentin

[Invité]

Bonjour,

Il faut tester le nombre de shapes préalablement.
Perso, je travaille avec des index pour sélectionner les objets d'une collection comme dans ce code, c'est beaucoup plus lisible.

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
 
Sub MiseEnPage()
 
Dim I As Integer, J As Integer
 
    With ActivePresentation
         ' on boucle sur la collection des diapositives
         For I = 1 To .Slides.Count
 
             Select Case I
                    Case 1, 3, 7
 
                    Case Else
 
                         With .Slides(I)
                              ' on boucle sur la collection des shapes
                              If .Shapes.Count > 0 Then
 
                                 If .Shapes.Count > 0 Then With .Shapes(1):  .Left = 10:  .Top = 20: End With
                                 If .Shapes.Count > 1 Then With .Shapes(2):  .Left = 310:  .Top = 20: End With
                                 If .Shapes.Count > 2 Then With .Shapes(3):  .Left = 620:  .Top = 20: End With
                                 If .Shapes.Count > 3 Then With .Shapes(4):  .Left = 10:  .Top = 300: End With
                                 If .Shapes.Count > 4 Then With .Shapes(5):  .Left = 310:  .Top = 300: End With
                                 If .Shapes.Count > 5 Then With .Shapes(6):  .Left = 620:  .Top = 300: End With
 
                                 For J = 1 To .Shapes.Count
                                     ' on teste si c'est une shape de type image
                                     With .Shapes(J)
                                          If .Type = msoPicture Then .Width = 300: .Height = 220
                                     End With
                                 Next J
                              End If
 
 
                         End With
               End Select
         Next I
     End With
 
End Sub

Sinon, ce code est placé dans un module standard d'un fichier .pptm. Si vous devez conserver ce code, transformez votre présentation en modèle .potm.

[Quentin987]

Merci beaucoup.