Discussion :

[fidecourt]

bonjour à tous,

j'ai une macro qui génère depuis excel un diaporama contenant les données d'un tableau
je voudrais qu'il y ait un saut de page après la 13ème ligne de données
actuellement, cela génère une liste sans saut de page, quelque soit le nombre de lignes générées
bien sûr ce nombre de ligne diffère en fonction du choix effectué dans un formulaire
voici le 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
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
71
72
73
74
75
76
Sub PPTlisteAgr() 'liste de tous les agréments dans la même cellule
 
Dim objPPT As Object 'PowerPoint.Application  'Object
Dim objPres As Object 'PowerPoint.Presentation ' Object
Dim objSld As Object 'PowerPoint.SlideRange ' Object
Dim objShp As Object 'PowerPoint.Shape ' Object
Dim shp As Object 'PowerPoint.Shape
Dim Tablo As Variant
Dim x As Integer, i As Integer, y As Integer
 
 
With Sheets("AgrementsListeTriee") 'Il faut presiser le "." dans la suite du code pour y faire reference
    Tablo = .Range("A2:Z" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
End With
 
Set objPPT = CreateObject("Powerpoint.Application")
objPPT.Visible = True
 
Set objPres = objPPT.Presentations.Open(ThisWorkbook.Path & "\ListeAgr.pptm")
objPres.SaveAs ThisWorkbook.Path & "\Agrements.pptm"
 
 
 
 
    'duplique le slide 1
    Set objSld = objPres.Slides(1).Duplicate
    'On le place au dessous de tout
    objSld.moveto objPres.Slides.Count
    'remplit le tableau du slide avec les données
 
    For Each objShp In objSld.Shapes
     For i = 1 To UBound(Tablo)
        If objShp.HasTable Then
 
            With objShp.Table
                .Cell(2, 1).Shape.TextFrame.TextRange.Text = Tablo(i, 1) 'Famille Col A
                .Cell(2, 2).Shape.TextFrame.TextRange.Text = Tablo(i, 2) 'Calibre Col B
                .Cell(2, 3).Shape.TextFrame.TextRange.Text = (Tablo(i, 6) & "/" & Tablo(i, 9) & "/" & Tablo(i, 11) & "/" & Tablo(i, 13) & "/" & Tablo(i, 15)) 'Agrément1 Col F
                .Cell(2, 4).Shape.TextFrame.TextRange.Text = Tablo(i, 8) 'Designation produit1 Col H
                .Cell(2, 5).Shape.TextFrame.TextRange.Text = Tablo(i, 3) 'Classe Col C
                .Cell(2, 6).Shape.TextFrame.TextRange.Text = Tablo(i, 7) 'Distance sécurité1 Col G
                .Cell(2, 7).Shape.TextFrame.TextRange.Text = Tablo(i, 4) 'PT MA Col D
                '=============================================================================
                 x = 0
                Do
                If Tablo(i, 1) <> "" Then
                       .Rows.Add
 
                .Cell(2 + (1 * x), 1).Shape.TextFrame.TextRange.Text = Tablo(i, 1) 'Famille Col A
                .Cell(2 + (1 * x), 2).Shape.TextFrame.TextRange.Text = Tablo(i, 2) 'Calibre Col B
                .Cell(2 + (1 * x), 3).Shape.TextFrame.TextRange.Text = (Tablo(i, 6) & "   " & Tablo(i, 9) & "   " & Tablo(i, 11) & "   " & Tablo(i, 13) & "   " & Tablo(i, 15)) 'Agrément1 Col F
                .Cell(2 + (1 * x), 4).Shape.TextFrame.TextRange.Text = Tablo(i, 8) 'Designation produit1 Col H
                .Cell(2 + (1 * x), 5).Shape.TextFrame.TextRange.Text = Tablo(i, 3) 'Classe Col C
                .Cell(2 + (1 * x), 6).Shape.TextFrame.TextRange.Text = Tablo(i, 7) 'Distance sécurité1 Col G
                .Cell(2 + (1 * x), 7).Shape.TextFrame.TextRange.Text = Tablo(i, 4) 'PT MA Col D
 
 
                End If
                    'End If
                    'et autant de fois qu'il y a de lignes où cell B = G
                    i = i + 1
                    x = x + 1
                    If i > UBound(Tablo) Then Exit Do
                Loop While Tablo(i, 1) <> ""
 
                End With
        End If
 
    Next
Next
 
objPres.Slides(1).Delete
objPres.save
objPres.Close
 
End Sub

Une idée ?

[fidecourt]

voir la discussion :
Piloter POWERPOINT depuis Excel - Ajouter un nouveau slide après la 12ème ligne

dans ce même forum, il y a toutes les explications et le code qui fonctionne
grâce à l'aide précieuse de Qwazerty