Discussion :

[gabvoir]

Bonjour,

J'ai un petit soucis pour générer un complément PPT.
Je cré normalement mon fichier .pptm, une fois entièrement fonctionnelle, je fais enregistrer sous, et je met en extension .ppam.
Ensuite quand j'ajoute le complément à mon PPT, le projet VBA n'est pas chargé, aucun module n'est présent.
En fait quand j'utilise un bouton de la barre d'accès rapide un message du type "La macro est introuvable ou a été désactivée en raison de vos paramètres de sécurité", alors que j'ai bien cliquer sur "Activer les macros"

Y a t'il des conditions spécifiques pour créer un complément ?
La compilation du projet VBA ne renvoi aucune erreur.
Toute les références sont bien présente.

Merci pour votre aide !

gabvoir

[Invité]

Bonjour

As-tu lu ces tutos avec des compléments PPT : http://powerpoint.developpez.com/cou...vba#complement

Philippe

[gabvoir]

Bonjour,

Merci pour ces liens en effet, j'étais tombé sur ces tutos, et il ne semble pas qu'il y ait de réel spécificité a la création du ppam ?
Je me trompe ? j'oubli kkchose ?

EDIT : je vous met mon code VBA qui n'est pas énorme en soit
Pour infos cela permet de créer un publipostage d'un slide a partir d'un fichier excel.

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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
 
Option Explicit
 
Public Sub publiposter()
Dim BdI As FileDialog
Dim NomFich
Set BdI = Application.FileDialog(msoFileDialogOpen)
With BdI
    .Title = "Ouvrir base"
    .Filters.Clear
    .InitialFileName = Application.ActivePresentation.Path
    .Filters.Add "Classeurs Excel", "*.xls; *.xlsx; *.xlsm"
    .AllowMultiSelect = False
    .FilterIndex = 1
    .Show 'ouvre la boîte de dialogue
End With
If BdI.SelectedItems.Count = 0 Then Exit Sub
NomFich = BdI.SelectedItems(1)
Set BdI = Nothing
 
 
Dim xlApp As Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim col As Range
Dim row As ListRow
Dim coll As Collection
Dim bdd As Scripting.Dictionary
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Set xlWorkBook = xlApp.Workbooks.Open(NomFich, True, False)
Set bdd = CreateObject("Scripting.Dictionary")
With xlWorkBook.Sheets(1).listobjects(1)
    For Each col In .HeaderRowRange
        Set coll = New Collection
        For Each row In .ListRows
            coll.Add (row.Range.Columns(col.Column).Value)
        Next row
        bdd.Add col.Value, coll
    Next col
End With
xlWorkBook.Close
xlApp.Quit
Set xlApp = Nothing
Set xlWorkBook = Nothing
Set coll = Nothing
 
 
Dim sld As Slide
Dim sldBase As Slide
Dim shp As Shape
Dim indexSlide As Integer
Dim i As Integer
Set sldBase = ActivePresentation.Application.ActiveWindow.View.Slide
MsgBox sldBase.SlideIndex
indexSlide = sldBase.SlideIndex
For i = 1 To bdd.Items(1).Count
    sldBase.copy
    indexSlide = indexSlide + 1
    Set sld = ActivePresentation.Slides(ActivePresentation.Slides.Paste(indexSlide).SlideIndex)
    For Each shp In sld.Shapes
        If bdd.Exists(shp.Name) Then
            If shp.Type = msoPicture Then
                Dim l As Long, t As Long, h As Long, w As Long
                Dim strName As String
                l = shp.Left
                t = shp.Top
                h = shp.Height
                w = shp.Width
                strName = shp.Name
                shp.Delete
                Set shp = sld.Shapes.AddPicture(Application.ActivePresentation.Path & "\" & bdd(strName)(i), _
                msoFalse, msoCTrue, l, t, w, h)
                shp.Name = strName
            ElseIf shp.Type = msoTextBox Then
                shp.TextFrame.TextRange.Text = bdd(shp.Name)(i)
            End If
        End If
    Next shp
Next i
 
 
Set bdd = Nothing
 
End Sub
Public Sub renommerForme()
Dim Name$
On Error GoTo AbortNameShape
 
If ActiveWindow.Selection.ShapeRange.Count = 0 Then
MsgBox "Pas de forme sélectionnée", vbCritical
Exit Sub
End If
If ActiveWindow.Selection.ShapeRange.Count > 1 Then
MsgBox "Veuillez ne sélectionner qu'une seule forme", vbCritical
Exit Sub
End If
Name$ = ActiveWindow.Selection.ShapeRange(1).Name
 
Name$ = InputBox$("Donner un nom à cette forme", "Shape Name", Name$)
 
If Name$ <> "" Then
ActiveWindow.Selection.ShapeRange(1).Name = Name$
End If
Exit Sub
 
AbortNameShape:
MsgBox "Pas de forme sélectionnée", vbCritical
 
End Sub

[gabvoir]

Je pense savoir d'où cela provient.
Lorsque j'ajoute mon bouton dans la barre d'accès rapide, je le fait sur mon fichier .pptm.
Le raccourci qui se créé se fait donc vers monfichier.pptm!renommerForme.
Cependant, quand je sauvegarde en .ppam, ce lien vers pptm doit etre conservé et n'est pas mis à jour vers .ppam.

Comment faire ? Avez vous une astuce ?

Merci !

Gabvoir

[gabvoir]

Quelqu'un aurait une idée ?

Merci

Gabvoir