XL 2010 créer un fichier powerpoint à partir d'excel

M

Mak_tarmak

XLDnaute Junior
Bonjour,
Dans mon fichier ci-joint, l'onglet Tableau recense, dans le désordre, les dates de formation qui se déroule sur une semaine.
Est-ce qu'il est possible via macro ou une autre fonction de générer des fichiers powerpoint pour chaque jour de la semaine et d'y inclure les formations du jour comme dans mon onglet Affichage ?
En vous remerciant pour votre aide,
Cordialement,
 

Pièces jointes

  • Tableau.xlsx
    20.7 KB · Affichages: 8
Trier par date Trier par votes
M

Mak_tarmak

XLDnaute Junior
cp4 à dit:
Bonjour,

Si ça peut d'aider ICI
Cliquez pour agrandir...
Bonjour cp4,
Est-ce que tu crois que je peux faire une adaptation de ta macro sur le tableau que tu m'as généré et ainsi remplir 5 onglets (LUNDI, MARDI, MERCREDI...) que j'aurai créé dans le fichier et éclaté chaque groupe de la même date sur le jour adapté ? (peut-être en estimant que la date la plus "faible" correspond au lundi et cette date+1 correspond au jour suivant, à moins qu'il soit possible de vérifier si c'est bien un lundi.
Comme ça, je pourrai utiliser le lien que tu m'as posté pour générer un powerpoint à partir de chaque onglet représentant un jour de la semaine.
En te remerciant,
 
Vote positif 0 Vote négatif
cp4

cp4

XLDnaute Barbatruc
Mak_tarmak à dit:
Bonjour cp4,
Est-ce que tu crois que je peux faire une adaptation de ta macro sur le tableau que tu m'as généré et ainsi remplir 5 onglets (LUNDI, MARDI, MERCREDI...) que j'aurai créé dans le fichier et éclaté chaque groupe de la même date sur le jour adapté ? (peut-être en estimant que la date la plus "faible" correspond au lundi et cette date+1 correspond au jour suivant, à moins qu'il soit possible de vérifier si c'est bien un lundi.
Comme ça, je pourrai utiliser le lien que tu m'as posté pour générer un powerpoint à partir de chaque onglet représentant un jour de la semaine.
En te remerciant,
Cliquez pour agrandir...
Bonjour,

J'avoue que je n'ai pas compris ta demande. Je te signale que le code du lien n'est pas de ma conception.
Pour info, j'ai testé le code chez-moi et il plantait à cause de la déclaration de 2 variables.
Voici le code corrigé
VB: 
Option Explicit

Sub Export_Ppt()
'necessite d'activer la reference Microsoft Powerpoint Object Library
    Dim PptDoc As Object, PPT As Object, NbShpe As Byte
    '''''''''''''''''''''''''''''''''''''''''''''''
    Set PPT = CreateObject("Powerpoint.Application")
    PPT.Visible = True    'l'application sera visible
    Set PptDoc = PPT.Presentations.Open(ThisWorkbook.Path & "/Présentation1.ppt")    'ouverture fichier ppt
    Dim Feuille As Worksheet, I As Integer, J As Integer, NbreGraphiques As Integer
    I = 1
    For Each Feuille In ThisWorkbook.Worksheets
        NbreGraphiques = Feuille.Shapes.Count
        For J = 1 To NbreGraphiques
            If Feuille.Shapes(J).Name <> "CommandButton1" Then
                PptDoc.Slides.Add I, ppLayoutBlank
                Feuille.Shapes(J).Copy
                PptDoc.Slides(I).Shapes.Paste
                I = I + 1
            End If
        Next J
    Next
    PptDoc.Save    'sauvegarder les modifications
    PptDoc.Close    'fermer le document ppt
    PPT.Quit    'fermer l'application powerPoint
End Sub
 
Vote positif 0 Vote négatif
M

Mak_tarmak

XLDnaute Junior
cp4 à dit:
Bonjour,

J'avoue que je n'ai pas compris ta demande. Je te signale que le code du lien n'est pas de ma conception.
Pour info, j'ai testé le code chez-moi et il plantait à cause de la déclaration de 2 variables.
Voici le code corrigé
VB: 
Option Explicit

Sub Export_Ppt()
'necessite d'activer la reference Microsoft Powerpoint Object Library
    Dim PptDoc As Object, PPT As Object, NbShpe As Byte
    '''''''''''''''''''''''''''''''''''''''''''''''
    Set PPT = CreateObject("Powerpoint.Application")
    PPT.Visible = True    'l'application sera visible
    Set PptDoc = PPT.Presentations.Open(ThisWorkbook.Path & "/Présentation1.ppt")    'ouverture fichier ppt
    Dim Feuille As Worksheet, I As Integer, J As Integer, NbreGraphiques As Integer
    I = 1
    For Each Feuille In ThisWorkbook.Worksheets
        NbreGraphiques = Feuille.Shapes.Count
        For J = 1 To NbreGraphiques
            If Feuille.Shapes(J).Name <> "CommandButton1" Then
                PptDoc.Slides.Add I, ppLayoutBlank
                Feuille.Shapes(J).Copy
                PptDoc.Slides(I).Shapes.Paste
                I = I + 1
            End If
        Next J
    Next
    PptDoc.Save    'sauvegarder les modifications
    PptDoc.Close    'fermer le document ppt
    PPT.Quit    'fermer l'application powerPoint
End Sub
Cliquez pour agrandir...
cp4,
j'avais bien compris que le lien n'était pas de toi.
En fait, sur mon autre discussion, ta macro servait à traiter mon extraction et à construire un tableau dans l'onglet Tableau. Je souhaiterais adapter ta macro pour en faire une deuxième qui gère le tableau de l'onglet Tableau que tu as créé et l'"éclate" pour en construire 5 autres sur les différents jours de la semaine dans 5 onglets supplémentaires.
J'espère que ma demande est plus claire sinon je peux retravailler le fichier excel que je t'avais joint pour te montrer ce que je souhaiterai en sortie si c'est mieux pour comprendre ma demande.
Merci pour ta correction de code.
Cordialement mak_tarmak,
 
Vote positif 0 Vote négatif
cp4

cp4

XLDnaute Barbatruc
Mak_tarmak à dit:
cp4,
j'avais bien compris que le lien n'était pas de toi.
En fait, sur mon autre discussion, ta macro servait à traiter mon extraction et à construire un tableau dans l'onglet Tableau. Je souhaiterais adapter ta macro pour en faire une deuxième qui gère le tableau de l'onglet Tableau que tu as créé et l'"éclate" pour en construire 5 autres sur les différents jours de la semaine dans 5 onglets supplémentaires.
J'espère que ma demande est plus claire sinon je peux retravailler le fichier excel que je t'avais joint pour te montrer ce que je souhaiterai en sortie si c'est mieux pour comprendre ma demande.
Merci pour ta correction de code.
Cordialement mak_tarmak,
Cliquez pour agrandir...
@Mak_tarmak : J'ai à peu près compris mais pas beaucoup de temps ces prochains jours.
 
Vote positif 0 Vote négatif
cp4

cp4

XLDnaute Barbatruc
Mak_tarmak à dit:
pas de soucis, je vais essayer d'avancer de mon côté, merci
Cliquez pour agrandir...
Bonsoir,

J'ai trouvé un peu de temps.
Le code supprime les feuilles (lundi,mardi,mercredi,jeudi,vendredi); ensuite elles sont recréées.
VB: 
Option Explicit
Sub Ajout_feuilles_jour()
    Dim d As Object, cel As Range, i As Integer, plg As Range, j As Integer
    Set d = CreateObject("scripting.dictionary")
    With Sheets("tableau")
        Set plg = .[A1].CurrentRegion
        For Each cel In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
            d(Format(cel.Value2, "dddd")) = ""
        Next cel

        For i = 0 To d.Count - 1
            On Error Resume Next
            Application.DisplayAlerts = False
            Sheets(d.keys()(i)).Delete
            Application.DisplayAlerts = True
            
            Sheets.Add After:=Worksheets(Worksheets.Count())
            ActiveSheet.Name = d.keys()(i)
            plg.Copy Sheets(d.keys()(i)).Range("A3")
            'Sheets.Add.Name = d.keys()(i)
            For j = Range("a" & Rows.Count).End(xlUp).Row To 5 Step -1
                If Format(Range("a" & j).Value, "dddd") <> ActiveSheet.Name Then Range("a" & j).EntireRow.Delete
            Next j
            
            Range("b1") = Range("a4")
            Range("b1").NumberFormat = """Formation(s) du ""dddd dd mmmm yyyy"
            
            With Range("b1:b2")
                .Merge
                .Font.Bold = True
                .Font.Size = 16
                .VerticalAlignment = xlCenter
                .HorizontalAlignment = xlCenter
            End With
            Cells.EntireColumn.AutoFit
        Next i
    End With
End Sub
Voir si ça te convient.

Bonne soirée.
 
Vote positif 0 Vote négatif
M

Mak_tarmak

XLDnaute Junior
cp4 à dit:
Bonsoir,

J'ai trouvé un peu de temps.
Le code supprime les feuilles (lundi,mardi,mercredi,jeudi,vendredi); ensuite elles sont recréées.
VB: 
Option Explicit
Sub Ajout_feuilles_jour()
    Dim d As Object, cel As Range, i As Integer, plg As Range, j As Integer
    Set d = CreateObject("scripting.dictionary")
    With Sheets("tableau")
        Set plg = .[A1].CurrentRegion
        For Each cel In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
            d(Format(cel.Value2, "dddd")) = ""
        Next cel

        For i = 0 To d.Count - 1
            On Error Resume Next
            Application.DisplayAlerts = False
            Sheets(d.keys()(i)).Delete
            Application.DisplayAlerts = True
           
            Sheets.Add After:=Worksheets(Worksheets.Count())
            ActiveSheet.Name = d.keys()(i)
            plg.Copy Sheets(d.keys()(i)).Range("A3")
            'Sheets.Add.Name = d.keys()(i)
            For j = Range("a" & Rows.Count).End(xlUp).Row To 5 Step -1
                If Format(Range("a" & j).Value, "dddd") <> ActiveSheet.Name Then Range("a" & j).EntireRow.Delete
            Next j
           
            Range("b1") = Range("a4")
            Range("b1").NumberFormat = """Formation(s) du ""dddd dd mmmm yyyy"
           
            With Range("b1:b2")
                .Merge
                .Font.Bold = True
                .Font.Size = 16
                .VerticalAlignment = xlCenter
                .HorizontalAlignment = xlCenter
            End With
            Cells.EntireColumn.AutoFit
        Next i
    End With
End Sub
Voir si ça te convient.

Bonne soirée.
Cliquez pour agrandir...
Bonsoir cp4,
C'est exactement ce que je voulais faire.
Par contre, la date du premier jour se retrouve sur les autres jours, je n'ai pas réussi à trouver où ça pouvait se passer dans la boucle, si c'est bien dans la boucle :)
J'ai rajouté ta fonction pour les ppt dans le module mais je ne suis pas sûr que je puisse les coller à la suite.
Merci beaucoup pour ton aide,
Bonne soirée,
 

Pièces jointes

  • Tableau.xlsm
    38.2 KB · Affichages: 5
Vote positif 0 Vote négatif
cp4

cp4

XLDnaute Barbatruc
Mak_tarmak à dit:
Bonsoir cp4,
C'est exactement ce que je voulais faire.
Par contre, la date du premier jour se retrouve sur les autres jours, je n'ai pas réussi à trouver où ça pouvait se passer dans la boucle, si c'est bien dans la boucle :)
J'ai rajouté ta fonction pour les ppt dans le module mais je ne suis pas sûr que je puisse les coller à la suite.
Merci beaucoup pour ton aide,
Bonne soirée,
Cliquez pour agrandir...
Bonjour,

L’erreur est sur cette ligne de code:
VB: 
For J = Range("a" & Rows.Count).End(xlUp).Row To 5 Step -1
Les données commencent à la ligne 4, il faut donc modifier le 5 par 4.
Note bien que je ne me suis pas intéressé au powerpoint. Je ne sais donc pas si ça fonctionne bien.

Bonne journée.
 
Vote positif 0 Vote négatif
M

Mak_tarmak

XLDnaute Junior
Mak_tarmak à dit:
Bonsoir cp4,
C'est exactement ce que je voulais faire.
Par contre, la date du premier jour se retrouve sur les autres jours, je n'ai pas réussi à trouver où ça pouvait se passer dans la boucle, si c'est bien dans la boucle :)
J'ai rajouté ta fonction pour les ppt dans le module mais je ne suis pas sûr que je puisse les coller à la suite.
Merci beaucoup pour ton aide,
Bonne soirée,
Cliquez pour agrandir...

cp4 à dit:
Bonjour,

L’erreur est sur cette ligne de code:
VB: 
For J = Range("a" & Rows.Count).End(xlUp).Row To 5 Step -1
Les données commencent à la ligne 4, il faut donc modifier le 5 par 4.
Note bien que je ne me suis pas intéressé au powerpoint. Je ne sais donc pas si ça fonctionne bien.

Bonne journée.
Cliquez pour agrandir...
Bonjour,
En modifiant à 4, ça fonctionne nickel.
Pour le powerpoint, j'avais testé l'exemple et ça fonctionnait en plaçant le fichier powerpoint dans le même répertoire que le fichier excel, mais l'exemple portait sur l'export de graphique.
Je vais essayer de voir s'il peut être adapté pour exporter dans le même fichier ppt mes 5 onglets.
Je te remercie pour ton aide précieuse.
Passes également une bonne journée.
 
Vote positif 0 Vote négatif
M

Mak_tarmak

XLDnaute Junior
Mak_tarmak à dit:
Bonjour,
En modifiant à 4, ça fonctionne nickel.
Pour le powerpoint, j'avais testé l'exemple et ça fonctionnait en plaçant le fichier powerpoint dans le même répertoire que le fichier excel, mais l'exemple portait sur l'export de graphique.
Je vais essayer de voir s'il peut être adapté pour exporter dans le même fichier ppt mes 5 onglets.
Je te remercie pour ton aide précieuse.
Passes également une bonne journée.
Cliquez pour agrandir...
J'ai trouvé ce code qui semblait prometteur et que j'ai essayé d'adapter mais cela ne fonctionne pas.

VB :

Sub exporterVersPowerpointPlusieursPages()

Dim oPowerpoint As Object
Set oPowerpoint = CreateObject("Powerpoint.application")

Dim oDiaporama As Object
Set oDiaporama = oPowerpoint.Presentations.Add

Dim idDiapo As Integer, debut As Integer, i As Integer, ligneSaut As Object, derniereColonne As Object, ligneFin As Object, Left As Object, plage As Object
idDiapo = 1

Dim ws As Worksheet

For Each ws In ActiveWorkbook.Sheets(Array("lundi", "mardi"))

' 1 récupérer les adresses des pages d'impressions
Dim plages As String: plages = ""

With ws.HPageBreaks

If .Count = 0 Then
plages = ws.UsedRange.Address & "-"
Else
debut = 1
For i = 1 To .Count
ligneSaut = .Item(i).Location.Row

derniereColonne = ws.UsedRange.Columns.Count

plages = plages & Range(ws.Cells(debut, 1), ws.Cells(ligneSaut - 1, derniereColonne)).Address & "-"

debut = ligneSaut
Next

ligneFin = ws.UsedRange.Rows.Count
plages = plages & Range(ws.Cells(debut, 1), ws.Cells(ligneFin - 1, derniereColonne)).Address & "-"

End If
End With

plages = Left(plages, Len(plages) - 1)

' 2 exporter vers powerpoint


For Each plage In Split(plages, "-")
Dim oDiapositive As Object
Set oDiapositive = oDiaporama.Slides.Add(Index:=idDiapo, Layout:=12)

ws.Range(plage).Copy
oDiaporama.Slides(idDiapo).Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile

idDiapo = idDiapo + 1
Next
Next

End Sub
 
Vote positif 0 Vote négatif
cp4

cp4

XLDnaute Barbatruc
Mak_tarmak à dit:
J'ai trouvé ce code qui semblait prometteur et que j'ai essayé d'adapter mais cela ne fonctionne pas.

VB :

Sub exporterVersPowerpointPlusieursPages()

Dim oPowerpoint As Object
Set oPowerpoint = CreateObject("Powerpoint.application")

Dim oDiaporama As Object
Set oDiaporama = oPowerpoint.Presentations.Add

Dim idDiapo As Integer, debut As Integer, i As Integer, ligneSaut As Object, derniereColonne As Object, ligneFin As Object, Left As Object, plage As Object
idDiapo = 1

Dim ws As Worksheet

For Each ws In ActiveWorkbook.Sheets(Array("lundi", "mardi"))

' 1 récupérer les adresses des pages d'impressions
Dim plages As String: plages = ""

With ws.HPageBreaks

If .Count = 0 Then
plages = ws.UsedRange.Address & "-"
Else
debut = 1
For i = 1 To .Count
ligneSaut = .Item(i).Location.Row

derniereColonne = ws.UsedRange.Columns.Count

plages = plages & Range(ws.Cells(debut, 1), ws.Cells(ligneSaut - 1, derniereColonne)).Address & "-"

debut = ligneSaut
Next

ligneFin = ws.UsedRange.Rows.Count
plages = plages & Range(ws.Cells(debut, 1), ws.Cells(ligneFin - 1, derniereColonne)).Address & "-"

End If
End With

plages = Left(plages, Len(plages) - 1)

' 2 exporter vers powerpoint


For Each plage In Split(plages, "-")
Dim oDiapositive As Object
Set oDiapositive = oDiaporama.Slides.Add(Index:=idDiapo, Layout:=12)

ws.Range(plage).Copy
oDiaporama.Slides(idDiapo).Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile

idDiapo = idDiapo + 1
Next
Next

End Sub
Cliquez pour agrandir...
edit: message modifié.

Clique sur image de la feuille "Logo" pour exécuter les codes.
Il suffira de mettre en forme le powerpoint.
 

Pièces jointes

  • Tableau v2.xlsm
    38.8 KB · Affichages: 11
Dernière édition:
Vote positif 0 Vote négatif
M

Mak_tarmak

XLDnaute Junior
cp4 à dit:
edit: message modifié.

Clique sur image de la feuille "Logo" pour exécuter les codes.
Il suffira de mettre en forme le powerpoint.
Cliquez pour agrandir...
Merci.
J'avais une variable non définie sur layout mais elle a disparu en activant la library powerpoint dans l'éditeur de code.
Encore merci pour ton aide qui m'a permis de comprendre un peu mieux le vba.
Prochaine étape la mise en forme du powerpoint.
Bonne fin d'après-midi.
 
Vote positif 0 Vote négatif

Discussions similaires

S
  • Question
Microsoft 365 Redimensionnement automatique des tableaux excel en liaison dans powerpoint (réduction de la taille)
Réponses
0
Affichages
367
samuelcouni
S
C
  • Question
Microsoft 365 Synthèse de données
2
Réponses
23
Affichages
868
Corinne
C
V
  • Question
Microsoft 365 analyse d'un tableau de données
Réponses
5
Affichages
490
vousoft
V
S
  • Résolu(e)
XL 2010 tableau de cumul automatisé
Réponses
13
Affichages
381
stefiskool
S
P
  • Question
Microsoft 365 Créer un tableau à partir de données entre deux dates
Réponses
6
Affichages
491
Pat-Sib
P
E
  • Question
Microsoft 365 Etalage d'heures à partir de données
Réponses
8
Affichages
487
eiola
E
I
  • Résolu(e)
Microsoft 365 Garder dimension des graphes issus d'un lien Excel lors de la MaJ dans PP
Réponses
2
Affichages
441
ilyes4205
I
WTF
  • Résolu(e)
Microsoft 365 Créer une base de données à partir de 2 onglets
Réponses
3
Affichages
471
WTF
WTF
cathodique
  • Résolu(e)
XL 2010 Reconstruire un tableau
2
Réponses
20
Affichages
944
cathodique
cathodique
F
  • Question
XL 2016 Générer un rapport pdf depuis excel
2
Réponses
21
Affichages
2 K
job75
job75

Membres actuellement en ligne

3 membres et 55 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 708
Messages
2 112 097
Membres
111 416
dernier inscrit
philipperoy83