Discussion :

[FFGUY]

Bonjour,

Je n'arrive pas sauver un powerpoint depuis une de mes Macros, J'obtiens un message d erreur: " Run-Time error 429 // ActiveX component can't create object.
Voici mon 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
77
78
79
80
81
82
83
84
85
86
87
 
Sub PPT()
 
' Set a VBE reference to Microsoft PowerPoint Object Library
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
 
Set PPApp = CreateObject("Powerpoint.Application")
 
With PPApp
.Visible = True
.Presentations.Open ("X:\blabla.pptx")
 
    For i = 34 To 34
 
    Set SteercoFile = Workbooks.Open(blabla).Range("L" & i))
 
    .ActiveWindow.View.GotoSlide (i - 22)
 
    ' Reference existing instance of PowerPoint
    Set PPApp = GetObject(, "Powerpoint.Application")
    ' Reference active presentation
    Set PPPres = PPApp.ActivePresentation
    ' Reference active slide
    Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
 
    ' Copy the range as a piicture
    If i <> 34 Then
    Worksheets("PPT").Range("A1:Q31").CopyPicture Appearance:=xlScreen, _
    Format:=xlPicture
    Else
    Worksheets("PPT").Range("F16:U44").CopyPicture Appearance:=xlScreen, _
    Format:=xlPicture
    End If
    ' Paste the range
    PPSlide.Shapes.Paste.Select
 
    ' Align the pasted range
    PPApp.ActiveWindow.Selection.ShapeRange.Height = 450
    PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    PPApp.ActiveWindow.Selection.ShapeRange.Top = 68
 
    ActiveWorkbook.Close False
    Next i
 
    .ActiveWindow.View.GotoSlide (2)
 
    ' Reference existing instance of PowerPoint
    Set PPApp = GetObject(, "Powerpoint.Application")
    ' Reference active presentation
    Set PPPres = PPApp.ActivePresentation
    ' Reference active slide
    Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
 
    ' Copy the range as a piicture
    Workbooks(blabla).Sheets(2).Range("B3:J22").CopyPicture Appearance:=xlScreen, _
    Format:=xlPicture
 
    ' Paste the range
    PPSlide.Shapes.Paste.Select
 
    ' Align the pasted range
    PPApp.ActiveWindow.Selection.ShapeRange.Height = 450
    PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    PPApp.ActiveWindow.Selection.ShapeRange.Top = 68
 
    ' Clean up
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set PPApp = Nothing
 
        File = blabla.Sheets(1).Range("B75")
        Savename = blabla.Sheets(1).Range("B76") & "\" & File & ".pptx"
        With ActivePresentation
        .SaveCopyAs Savename
        End With
 
End With
 
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Merci pour votre aide,

Romain

[thebenoit59]

Bonjour FFGUY.

Regarde du côté des références, si tu as bien activé celle de Powerpoint.

[FFGUY]

Bonjour Benoit,

Merci pour ta reponse.
En fait c'etait une erreur toute bête :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
 
' Clean up
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set PPApp = Nothing
 
        File = blabla.Sheets(1).Range("B75")
        Savename = blabla.Sheets(1).Range("B76") & "\" & File & ".pptx"
        With ActivePresentation
        .SaveCopyAs Savename
        End With

J ai fait mon clean avant de sauver :-( grrrrrrrrrrrrrrrrrrrrrrrrrrrrrr