Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Powerpoint Discussion :

Mise en page


Sujet :

Powerpoint

  1. #1
    Futur Membre du Club
    Mise en page
    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

  2. #2
    Expert éminent sénior
    Citation Envoyé par Quentin987 Voir le message

    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.
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  3. #3
    Futur Membre du Club
    Merci beaucoup.

###raw>template_hook.ano_emploi###