Discussion :

[LioBoni]

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
 
Sub total()
    ' Déclaration des variables
    Dim pptApp As Object
    Dim pptAppSource As Object
    Dim pptPresSource As Object
    Dim pptPresDest As Object
    Dim slideIndex As Integer
    Dim nomFichier As String
    Dim chemin As String
 
    'variable où stocker et comment nommer le nouveau ppt
    nomFichier = "test" & Format(Date, "yyyymmdd")
    chemin = "C:\Users\33666\Desktop\test macro mto"
 
    ' Définie le ppt ouvert comme source
    Set pptAppSource = GetObject(, "PowerPoint.Application")
    Set pptPresSource = pptAppSource.ActivePresentation
 
    'Rend visible le nouveau ppt le créer
    Set pptApp = CreateObject("PowerPoint.Application")
    pptApp.Visible = True
    Dim newppt As Object
    Set newppt = pptApp.Presentations.Add
    'fait en sorte que la nouvelle presentation soit attribuer à une variable et sauvé
    Set pptPresDest = pptApp.ActivePresentation
    pptPresDest.SaveAs chemin & "\" & nomFichier & ".pptx"
 
 
    slideIndex = Array(1, 2) ' Par exemple, copier la première et la deuxième diapositive
 
    Dim number As Integer
    For Each number In slideIndex
        pptPresSource.Slides(number).Copy
        pptPresDest.Slides.Paste
    Next number
 
    ' Nettoyer les objets
    Set pptPresDest = Nothing
    Set pptPresSource = Nothing
    Set pptAppSource = Nothing
End Sub

Bonjour,

Je me tourne vers vous car je suis face à un problème!
Je voudrais créer un nouveau ppt à partir d'un déjà existant, et faire en sorte que les diapos allant dans le nouveau ppt puissent être stocké dans une variable car celle ci changent souvent, le problème c'est que je n'arrive pas à utiliser cette variable dans mon code...

Auriez vous une idée à me donner ?

Merci d'avance

Lionel

[Nain porte koi]

Hello,

essayez comme ceci

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
 
Sub total()
    ' Déclaration des variables
    Dim pptApp As Object
    Dim pptAppSource As Object
    Dim pptPresSource As Object
    Dim pptPresDest As Object
    Dim slideIndex()
    Dim nomFichier As String
    Dim chemin As String
 
    'variable où stocker et comment nommer le nouveau ppt
    nomFichier = "test" & Format(Date, "yyyymmdd")
    chemin = "C:\Users\33666\Desktop\test macro mto"
 
    ' Définie le ppt ouvert comme source
    Set pptAppSource = GetObject(, "PowerPoint.Application")
    Set pptPresSource = pptAppSource.ActivePresentation
 
    'Rend visible le nouveau ppt le créer
    Set pptApp = CreateObject("PowerPoint.Application")
    pptApp.Visible = True
    Dim newppt As Object
    Set newppt = pptApp.Presentations.Add
    'fait en sorte que la nouvelle presentation soit attribuer à une variable et sauvé
    Set pptPresDest = pptApp.ActivePresentation
    pptPresDest.SaveAs chemin & "\" & nomFichier & ".pptx"
 
 
    slideIndex = Array(1, 2) ' Par exemple, copier la première et la deuxième diapositive
 
    Dim number As Integer
    For number = 0 To UBound(slideIndex)
        pptPresSource.Slides(number + 1).Copy
        pptPresDest.Slides.Paste
    Next number
 
    ' Nettoyer les objets
    Set pptPresDest = Nothing
    Set pptPresSource = Nothing
    Set pptAppSource = Nothing
End Sub

[Nain porte koi]

Ceci dit, pour importer des dispositives existantes il y a une solution visuelle assez simple (spéciale pour les AMIS )
Onglet Accueil, liste sous "Nouvelles dispositive", Réutiliser des dispositives, Parcourir, choisir le fichier, clic sur "Choisir le contenu", y'a plus qu'a choisir les diapos en cliquant sur la diapo voulu

[LioBoni]

Hello,

essayez comme ceci

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
 
Sub total()
    ' Déclaration des variables
    Dim pptApp As Object
    Dim pptAppSource As Object
    Dim pptPresSource As Object
    Dim pptPresDest As Object
    Dim slideIndex()
    Dim nomFichier As String
    Dim chemin As String
 
    'variable où stocker et comment nommer le nouveau ppt
    nomFichier = "test" & Format(Date, "yyyymmdd")
    chemin = "C:\Users\33666\Desktop\test macro mto"
 
    ' Définie le ppt ouvert comme source
    Set pptAppSource = GetObject(, "PowerPoint.Application")
    Set pptPresSource = pptAppSource.ActivePresentation
 
    'Rend visible le nouveau ppt le créer
    Set pptApp = CreateObject("PowerPoint.Application")
    pptApp.Visible = True
    Dim newppt As Object
    Set newppt = pptApp.Presentations.Add
    'fait en sorte que la nouvelle presentation soit attribuer à une variable et sauvé
    Set pptPresDest = pptApp.ActivePresentation
    pptPresDest.SaveAs chemin & "\" & nomFichier & ".pptx"
 
 
    slideIndex = Array(1, 2) ' Par exemple, copier la première et la deuxième diapositive
 
    Dim number As Integer
    For number = 0 To UBound(slideIndex)
        pptPresSource.Slides(number + 1).Copy
        pptPresDest.Slides.Paste
    Next number
 
    ' Nettoyer les objets
    Set pptPresDest = Nothing
    Set pptPresSource = Nothing
    Set pptAppSource = Nothing
End Sub

Merci de ta réponse mais le problème avec le code que tu m'as passé c'est que si je mets N valeurs au hasard dans slideIndex il va me copie coller les N premières diapos par exemple si je rentre les valeurs 1 3 5, il ne me copie colle pas les slides 1, 3 et 5 mais les 3 premières diapos,

De plus je voudrais m'affranchir de la selection des diapos et bien faire une macro car c'est un boulot répétitif que je fais le matin pas encore totalement réveillé

[Nain porte koi]

oups
remplacer pptPresSource.Slides(number + 1).Copy par pptPresSource.Slides(slideIndex(number)).Copy
Moi aussi pas réveillé

J'insiste un peu sur l'insertion manuelle car à la place des numéros c'est du visuel, et pas bien réveillé ça marche mieux

[LioBoni]

Merci beaucoup cela fonctionne!!
Le but est que je puisse faire un briefing avec toutes les slides et insertions d'images d'un côté et que quand celui ci est fini que je n'ai plus qu'a appuyer sur ma macro pour que je puisse avoir un brief avec seulement quelques slides venant du premier, puis un autre avec d'autres slides! En elevant l'erreur du choix des diapos