Automatiser une présentation power point

Bonjour à tous,

Problématique :

Je dois créer un book de repreneurs sur power point à partir d'un tableau Excel ou je veux récupérer les informations de 8 colonnes.

Voici à quoi ressemble la slide de destination :

Je veux donc remplir une slide avec les informations de 4 repreneurs différents soit 4 lignes différentes.

Voici le code que j'ai récupéré sur internet et adapté à ma sauce.

Le code va chercher les informations nécessaires dans un tableau Excel et les copie dans une shape (zone de texte)vba.

Sub CreateSlides_Text2()

'create slide for each name in list
'fill two text boxes
Dim myPT As Presentation
Dim xlApp As Object
Dim wbA As Object
Dim wsA As Object
Dim myList As Object
Dim myRng As Object
Dim i As Long
Dim col11 As Long
Dim col13 As Long
Dim col14 As Long
Dim col18 As Long
Dim col19 As Long
Dim col20 As Long
Dim col21 As Long
Dim col22 As Long
'columns with text for slides
col11 = 11
col13 = 13
col14 = 14
col18 = 18
col19 = 19
col20 = 20
col21 = 21
col22 = 22

On Error Resume Next
Set myPT = ActivePresentation
Set xlApp = GetObject(, "Excel.Application")
Set wbA = xlApp.ActiveWorkbook
Set wsA = wbA.ActiveSheet
Set myList = wsA.ListObjects(1)
On Error GoTo errHandler

If Not myList Is Nothing Then

  Set myRng = myList.DataBodyRange

  For i = 1 To myRng.Rows.Count
      With myPT
        'Copy first slide, paste after last slide
         .Slides(1).Copy
         .Slides.Paste (myPT.Slides.Count + 1)

         'change text in 1st textbox
         .Slides(.Slides.Count) _
           .Shapes(1).TextFrame.TextRange.Text _
             = myRng.Cells(i, col11).Value
         .Slides(.Slides.Count) _
         .Shapes(1).TextFrame.TextRange.Font _
         .Size = 10

         'change text in 2nd textbox
         .Slides(.Slides.Count) _
           .Shapes(2).TextFrame.TextRange.Text _
             = myRng.Cells(i, col13).Value
             .Slides(.Slides.Count) _
         .Shapes(2).TextFrame.TextRange.Font _
         .Size = 10

        .Slides(.Slides.Count) _
           .Shapes(3).TextFrame.TextRange.Text _
             = myRng.Cells(i, col14).Value

        .Slides(.Slides.Count) _
           .Shapes(4).TextFrame.TextRange.Text _
             = myRng.Cells(i, col18).Value

        .Slides(.Slides.Count) _
           .Shapes(5).TextFrame.TextRange.Text _
             = myRng.Cells(i, col19).Value

        .Slides(.Slides.Count) _
           .Shapes(6).TextFrame.TextRange.Text _
             = myRng.Cells(i, col20).Value

        .Slides(.Slides.Count) _
           .Shapes(7).TextFrame.TextRange.Text _
             = myRng.Cells(i, col21).Value

         .Slides(.Slides.Count) _
           .Shapes(8).TextFrame.TextRange.Text _
             = myRng.Cells(i, col22).Value

        .Slides(.Slides.Count) _
           .Shapes(9).TextFrame.TextRange.Text _
             = "Repreneur " & i

        'Moment ou je veux rajouter +1 à ma variable i

         'change text in 1st textbox
         .Slides(.Slides.Count) _
           .Shapes(10).TextFrame.TextRange.Text _
             = myRng.Cells(i, col11).Value
         .Slides(.Slides.Count) _
         .Shapes(1).TextFrame.TextRange.Font _
         .Size = 10

         'change text in 2nd textbox
         .Slides(.Slides.Count) _
           .Shapes(11).TextFrame.TextRange.Text _
             = myRng.Cells(i, col13).Value
             .Slides(.Slides.Count) _
         .Shapes(2).TextFrame.TextRange.Font _
         .Size = 10

        .Slides(.Slides.Count) _
           .Shapes(12).TextFrame.TextRange.Text _
             = myRng.Cells(i, col14).Value

        .Slides(.Slides.Count) _
           .Shapes(13).TextFrame.TextRange.Text _
             = myRng.Cells(i, col18).Value

        .Slides(.Slides.Count) _
           .Shapes(14).TextFrame.TextRange.Text _
             = myRng.Cells(i, col19).Value

        .Slides(.Slides.Count) _
           .Shapes(15).TextFrame.TextRange.Text _
             = myRng.Cells(i, col20).Value

        .Slides(.Slides.Count) _
           .Shapes(16).TextFrame.TextRange.Text _
             = myRng.Cells(i, col21).Value

         .Slides(.Slides.Count) _
           .Shapes(17).TextFrame.TextRange.Text _
             = myRng.Cells(i, col22).Value

        .Slides(.Slides.Count) _
           .Shapes(18).TextFrame.TextRange.Text _
             = "Repreneur " & i

        'Moment ou je veux rajouter +1 à ma variable i

      End With
  Next
Else
  MsgBox "No Excel table found on active sheet"
  GoTo exitHandler
End If

exitHandler:
  Exit Sub
errHandler:
  MsgBox "Could not complete slides"
  Resume exitHandler
End Sub

De base la macro est faite pour mettre une ligne par slide, hors, je veux en mettre 4.

Tout fonctionne, simplement j'ai remarqué que la variable i qui détermine quelle row la macro va chercher n'augmente de 1 seulement lorsque qu'une nouvelle slide n'est créé. J'aimerai qu'elle augmente de 1 dès que je change d'acheteur.

J'espère avoir été clair, avez-vous une solution ?

Grand merci

Bonjour

Sans doute

For i = 1 To myRng.Rows.Count step 4

puis utiliser i+1 puis i+2 puis i+3 quand tu alimentes les 2ème, 3ème et 4ème repreneurs de la slide

ou alors faire 2 boucles imbriquées, la 1ère par slide, la seconde pour alimenter chaque sous-slide

Merci beaucoup, ce n'est pas la première fois que vous m'aidez ! Il suffisait en effet de rajouter une ligne i=i+1 à chaque fois que je change de repreneurs, encore merci !