VBA - Excel to PowerPoint

C

Carnage029

XLDnaute Occasionnel
Hello a tous,

J'ai creer une macro qui me permet de copier mes objets sur une feuille Excel vers une slide powerpoint (un template ppt)
Le filling des slides se fait grace a une sheet mapping qui va recuperer le nom des onglets a copier ou le titre a mettre etc.

Cependant j'ai quelques soucis (deux en particuliers)

1 - Je n'arrive pas a trouver la bonne commande MSO pour copier le format/mise en pages mais en valeurs (sans lien vers le workbook), ce qui fait que des que je recalcule mon book les slides se mettent malheureusement a jour...

newPowerPoint.CommandBars.ExecuteMso "PasteBitmap"

2 - J'ai un soucis avec le timing de copy, quand je met un breaking point sur Next i, les slides se copient convenablement mais quand je laisse tourner la macro, toutes les copies se font sur la derniere slide de mon template, j'ai essaye de regler ca avec des pauses, sleeps et autres mais rien n'y fait...


Code: 
Add a reference to the Microsoft PowerPoint Library by:
    '1. Go to Tools in the VBA menu
    '2. Click on Reference
    '3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay
 
    'First we declare the variables we will be using
        Dim newPowerPoint As PowerPoint.Application
        Dim activeSlide As PowerPoint.Slide
        Dim cht As Excel.ChartObject
     
        Dim sTemplate As String
        sTemplate = "Chemin de mon template ppt"
        'With Presentations.Open(sTemplate, False, True, True)
 
                'Add slides here
         
      ' End With

     
     
     
     'Look for existing instance
        On Error Resume Next
        Set newPowerPoint = GetObject(, "PowerPoint.Application")
        On Error GoTo 0
     
    'Let's create a new PowerPoint
        If newPowerPoint Is Nothing Then
            Set newPowerPoint = New PowerPoint.Application
        End If
    'Make a presentation in PowerPoint
        If newPowerPoint.Presentations.Count = 0 Then
            newPowerPoint.Presentations.Open (sTemplate)
        End If
     
    'Show the PowerPoint
        newPowerPoint.Visible = True
    
    
    '-----------------------------------------------'
    ' Loop for the different levels'
    '-----------------------------------------------'
    
    Sheets("Export").Activate
    
For i = 10 To ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
    
    Dim mysheet As String
    mysheet = Cells(i, 2).Text
    
    level1 = Cells(i, 3).Text
    level2 = Cells(i, 4).Text
    level3 = Cells(i, 5).Text
    level4 = Cells(i, 6).Text
    level5 = Cells(i, 7).Text
    myindex = Cells(i, 1).Value
    mytitle = Cells(i, 8).Text
    
    
    Sheets(mysheet).Activate
    Cells(6, 21) = level1
    Cells(7, 21) = level2
    Cells(8, 21) = level3
    Cells(9, 21) = level4
    Cells(10, 21) = level5
    
    Application.Calculate
    If Not Application.CalculationState = xlDone Then
        DoEvents
    End If

    ActiveSheet.Shapes.SelectAll
    Selection.Copy
    
    DoEvents

    Set activeSlide = newPowerPoint.ActivePresentation.Slides(myindex)
    activeSlide.Shapes("TitleBox").TextFrame.TextRange.Text = mytitle
    activeSlide.Select
    newPowerPoint.CommandBars.ExecuteMso "PasteBitmap"
    
    newPowerPoint.Activate
    
    
    AppActivate ("Microsoft PowerPoint")
    Set activeSlide = Nothing
    AppActivate ("Microsoft Excel")
    ActiveWorkbook.Sheets("Export").Activate
Next i


End Sub

Merci beaucoup a vous de vos remarques et aide :)
Je veux juste preciser que je ne cherche pas a avoir une solution toute faite mais a comprendre comment faire :)
 

Pièces jointes

  • TemplatePPT.zip
    22.2 KB · Affichages: 25
  • MasterExcel.xlsm
    24.6 KB · Affichages: 35
  • MasterExcel.xlsm
    24.6 KB · Affichages: 34
  • MasterExcel.xlsm
    24.6 KB · Affichages: 41
Dernière édition:
Trier par date Trier par votes
C

Carnage029

XLDnaute Occasionnel
Re : VBA - Excel to PowerPoint

Hello,

Merci beaucoup de votre reponse,

J'ai cree deux fichiers qui ressemblent a mes fichiers (bien que beaucoup plus legers), il est possible que le probleme 2- n'apparaisse pas dans ce exemple simpliste :(

Petit soucis on ne peut pas uploader de fichier ppt, pot sur le forum, desole pour cet inconveniant, la seule chose que j'ai faite est creer un .pot avec 8 slides et chaque slide comporte une Textbox nomee "TitleBox"....

Il faut evidement mettre le bon chemin vers le template (.pot) dans le code VBA

Code: 
sTemplate = "TemplatePPT.pot"

Merci a vous :)
 

Pièces jointes

  • MasterExcel.xlsm
    24.6 KB · Affichages: 30
  • MasterExcel.xlsm
    24.6 KB · Affichages: 32
  • MasterExcel.xlsm
    24.6 KB · Affichages: 35
Vote positif 0 Vote négatif
C

Carnage029

XLDnaute Occasionnel
Re : VBA - Excel to PowerPoint

J'ai finallement reussi a regler le probleme 2- avec la definition d'un wait et en remplacant un slides(index).activate en gotoslide...

En revanche je n'arrive pas a coller avec la commande Mso pour que ca conserve le formating d'origine et que ca colle en valeurs (sans lien), en gros vu que je fais une dizaine de copier/coller du meme graphe (mais apres calcul a chauqe fois) ils devraient etre differents, mais comme le ppt garde le lien vers le workbook, toutes mes slides sont identiques...

Pour ceux que ca aide voila le code pour resoudre le probleme 2-

Code: 
Sub export2PDF()


'Add a reference to the Microsoft PowerPoint Library by:
    '1. Go to Tools in the VBA menu
    '2. Click on Reference
    '3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay
 
    'First we declare the variables we will be using
        Dim newPowerPoint As PowerPoint.Application
        Dim activeSlide As PowerPoint.Slide
        Dim cht As Excel.ChartObject
        
        Dim sTemplate As String
        sTemplate = "Template.potx" 'CHEMIN VERS LE TEMPLATE
     
     
     'Look for existing instance
        On Error Resume Next
        Set newPowerPoint = GetObject(, "PowerPoint.Application")
        On Error GoTo 0
     
    'Let's create a new PowerPoint
        If newPowerPoint Is Nothing Then
            Set newPowerPoint = New PowerPoint.Application
        End If
    'Make a presentation in PowerPoint
        If newPowerPoint.Presentations.Count = 0 Then
            newPowerPoint.Presentations.Open (sTemplate)
        End If
     
    'Show the PowerPoint
        newPowerPoint.Visible = True
        newPowerPoint.WindowState = 3
            
    
    '-----------------------------------------------'
    ' Loop for the different levels'
    '-----------------------------------------------'
    
    Sheets("Export").Activate
    
For i = 10 To ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
    
    Dim mysheet As String
    mysheet = Cells(i, 2).Text
    
    level1 = Cells(i, 3).Text
    level2 = Cells(i, 4).Text
    level3 = Cells(i, 5).Text
    level4 = Cells(i, 6).Text
    level5 = Cells(i, 7).Text
    myindex = Cells(i, 1).Value
    mytitle = Cells(i, 8).Text
    
    
    Sheets(mysheet).Activate
    Cells(6, 21) = level1
    Cells(7, 21) = level2
    Cells(8, 21) = level3
    Cells(9, 21) = level4
    Cells(10, 21) = level5
    
    Application.Calculate
    If Not Application.CalculationState = xlDone Then
        DoEvents
    End If

    ActiveSheet.Shapes.SelectAll
    Selection.Copy
    
    DoEvents
    
    newPowerPoint.Activate
    Set activeSlide = newPowerPoint.ActivePresentation.Slides(myindex)
    activeSlide.Shapes("TitleBox").TextFrame.TextRange.Text = mytitle
    newPowerPoint.ActiveWindow.View.GotoSlide Index:=myindex
    newPowerPoint.CommandBars.ExecuteMso "Paste"
    
    Wait 3
    
    Set activeSlide = Nothing
    
    AppActivate ("Microsoft Excel")
    
    ActiveWorkbook.Sheets("Export").Activate
    
Next i


End Sub
Private Sub Wait(ByVal nSec As Long)
    nSec = nSec + Timer
    While nSec > Timer
        DoEvents
    Wend
End Sub
 
Vote positif 0 Vote négatif
P

PMO2

XLDnaute Accro
Re : VBA - Excel to PowerPoint

Bonjour,

J'ai réaménagé votre code.
Je l'ai fait en liaison tardive (Late binding). Il n'y a plus besoin de faire référence à Microsoft PowerPoint.
Le .pot est à placer dans le même répertoire que le classeur mais vous pouvez adapter à votre convenance en modifiant l'instruction
Code: 
A$ = ThisWorkbook.Path & "\TemplatePPT.pot"

Voici le nouveau code
Code: 
Sub Convert2ppt()
'########################################################
'### Liaison tardive Late binding. Il n'y a plus      ###
'### besoin de faire référence à Microsoft PowerPoint ###
'########################################################
Dim NewPowerPoint As Object '(Liaison tardive Late binding) PowerPoint.Application
Dim PR As Object            '(Liaison tardive Late binding) PowerPoint.Presentation
Dim SL As Object            '(Liaison tardive Late binding) PowerPoint.Slide
Dim S As Worksheet
Dim cpt&    'compteur de slides
Dim i&
Dim A$
'---
Set NewPowerPoint = CreateObject("PowerPoint.Application")
NewPowerPoint.Visible = True
'#######################################################################################
'### le .pot est placé dans le même répertoire que le classeur (à adapter si besoin) ###
A$ = ThisWorkbook.Path & "\TemplatePPT.pot"
'#######################################################################################
Set PR = NewPowerPoint.Presentations.Open(A$)
    '-----------------------------------------------'
    ' Loop for the different levels'
    '-----------------------------------------------'
With Sheets("Extract")
  For i& = 10 To .Cells(Rows.Count, "B").End(xlUp).Row
    Set S = Sheets(.Cells(i, 2).Text)
    S.Activate
    S.Cells(6, 17) = .Cells(i&, 3)
    S.Cells(7, 17) = .Cells(i&, 4)
    S.Cells(8, 17) = .Cells(i&, 5)
    S.Cells(9, 21) = .Cells(i&, 6)
    S.Cells(10, 21) = .Cells(i&, 7)
    '---
    S.Shapes.SelectAll
    Selection.Copy
    S.[a1].Select
    '--- Les Slides ---
    cpt& = cpt& + 1
    Set SL = PR.Slides(cpt&)
    SL.Shapes(1).TextFrame.TextRange.Text = .Cells(i&, 1) & Space(1) & .Cells(i&, 8)
    With NewPowerPoint.ActiveWindow.View
      .GotoSlide cpt&
      .Paste
    End With
  Next i&
End With
End Sub
 

Pièces jointes

  • Carnage029.zip
    64.1 KB · Affichages: 48
Vote positif 0 Vote négatif
C

Carnage029

XLDnaute Occasionnel
Re : VBA - Excel to PowerPoint

Merci beaucoup a vous :)

J'ai recupere le code et adapte a mes besoins et c'est beaucoup plus fluide, et propre.
En revanche j'ai toujours le soucis du paste qui ne conserve pas le format de l'excel (couleurs et autres) et les shapes etant des graphs calcules a partir des cellules remplies depuis le mapping, le paste garde le lien et donc toutes mes slides sont identiques...
Je cherche a faire un paste en valeurs et en format.

Bonne nuit a vous :)
 
Vote positif 0 Vote négatif
P

PMO2

XLDnaute Accro
Re : VBA - Excel to PowerPoint

Bonjour,
Vous avez récupéré mon code et l'avez adapté.

Je constate que la pièce jointe n'a pas été téléchargée. Vous devriez le faire.

J'ai travaillé à partir de l'exemple que vous avez fourni et je ne suis pas en situation comme vous l'êtes.
Pour ses raisons, il est nécessaire que vous fassiez tourner la pièce qui est jointe pour vous rendre compte de son effet.
C'est la seule façon de savoir si c'est opérant ou pas.
 
Vote positif 0 Vote négatif
C

Carnage029

XLDnaute Occasionnel
Re : VBA - Excel to PowerPoint

Bonjour PM02,

Effectivement je n'avais pas telecharge la piece jointe, je vous prie de bien vouloir m'en excuser...

En revanche apres l'avoir regardee, je vois que pour pouvoir faire un paste en concervant les donnees, vous passez par la creation de plusieurs onglets, malheureusement ce n'est pas une solution que je peux appliquer.

Pour vous donner un petit etat des lieux, le fichier que je souhaite "coder" est un "master Excel" permettant d'aller chercher des informations de plusieurs fichiers (4 fichiers d'une taille comprise entre 10 et 25 megas). Les lignes de codes qui remplissent les cellules dans ma feuille d'origine servent a changer les informations "input".

Le but est donc de faire une boucle correspondante a mon "Extract" mapping afin de calculer les differentes feuilles (qui sont au final que 3 feuilles differentes en fonction de la mise en page et des informations que l'on souhaite obtenir et afficher), correspondantes aux differents "input".

J'ai beaucoup cherche sur internet et differentes sources, et je n'ai pas trouve comment coller a la fois le format et les donnees en "dur" mais sans lien vers le fichier d'origine, que ce soit avec pastespecial ou les commandes mso...

Je vais peut etre me rabatre vers une copie en image si jamais la solution que j'aurai aimee voir n'est pas possible.


PM02 je vous remercie grandement pour votre aide, ainsi que la macro que vous avez developpe et que j'ai pu adapter a mes besoins, macro beaucoup plus fluide et "propre" que celle que j'avais initiallement bricolee.

Bonne apres midi a vous a Paris :)
 
Vote positif 0 Vote négatif

Discussions similaires

S
  • Question
XL 2019 cellule Excel vers signet word : garder la mise en forme
Réponses
0
Affichages
846
Stateaid
S
R
  • Question
XL 2019 Fichier inscription VBA
Réponses
0
Affichages
799
Richard 58
R
M
  • Question
XL 2013 Erreur d'exécution 9 ou 13 que je n'arrive pas à résoudre.
2
Réponses
20
Affichages
3 K
massol
M
B
  • Question
boucle
Réponses
2
Affichages
765
BIL boud
B
M
  • Question
Ouvrir et scanner un pdf
Réponses
0
Affichages
1 K
Mgn_91
M
M
  • Question
[VBA] Envoie mail via excel
Réponses
1
Affichages
1 K
camarchepas
camarchepas
GADENSEB
  • Question
Excel / Gmail / Création de RDV
Réponses
4
Affichages
1 K
GADENSEB
GADENSEB
F
  • Question
[vba excel 2003] - probleme de mise a jour données listview
Réponses
5
Affichages
1 K
Paf
Paf
J
  • Question
Macro reliant outlook, problème de conversion de 2003 à 2010.
Réponses
0
Affichages
1 K
Jojolapin
J
R
  • Question
Concaténer plusierus fichiers .000 sur Excel en VBA
Réponses
5
Affichages
2 K
richert90
R

Membres actuellement en ligne

21 membres et 121 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
312 213
Messages
2 086 305
Membres
103 174
dernier inscrit
OBUTT