Bonjour,

J'ai un fichier excel avec 31 onglet (meme format). Je veux automatiser le reporting, mais j'ai quelques soucis. Pouvez vous m'aider? Merci par avance
Voici mon code. Jusqu'a "' Paste on last slide", cela fonctionne, apres plus rien en va...!


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
Option Explicit
 
Sub PresentationPPT()
'
' PresentationPPT Macro
 
Dim PPTApp As PowerPoint.Application
Dim PPTPres As PowerPoint.Presentation
Dim PPTSlide As PowerPoint.Slide
 
' Open the PPT presentation
 
    Set PPTApp = New PowerPoint.Application
    PPTApp.Visible = True
    PPTApp.Presentations.Open Filename:="Place of the ppt"
 
    For Each PPTPres In PPTApp.Presentations
        If PPTPres.Name = "ppt" Then
 
        Dim WS As Worksheet
        For Each WS In Worksheets
 
        ' Do not do it for sheet starting with the name X
        If Left(WS.CodeName, 1) = "X" Then GoTo Skip
 
            ' Create a new slide to the presentation
            Set PPTSlide = PPTPres.Slides.Add(PPTPres.Slides.Count + 1, ppLayoutText)
 
            ' Copy to the excel file
            Windows("Excel file name").Activate
            WS.Range("A1:AA149").Copy
            Application.CutCopyMode = False
 
            ' Paste on last slide
            PPTPres.SlideShowWindow.View.Last
            PPTSlide.Shapes.PasteSpecial(ppPasteBitmap).Select
 
            ' Align the pasted range
            PPTApp.ActiveWindow.Selection.ShapeRange.Align msoAlignLefts, True
            PPTApp.ActiveWindow.Selection.ShapeRange.Align msoAlignBottoms, True
 
Skip:
        Next
 
        End If
    Next
 
End Sub