Copier-coller Excel vers Powerpoint (tableaux)

nat54

XLDnaute Barbatruc
Bonjour,

Voilà mon « problème ».
Un fichier Excel avec environ 30 onglets formatés de façon identique
Je dois copier-coller les cellules de B2 à I37 de chaque onglet
Le but : un slide powerpoint par onglet excel

J’ai vu sur le site pour copier-coller des graphes mais pas de simples tableaux …

Merci de m’aider à automatiser cela en VBA, je gagnerais un temps fou

Dans ma besace excel j’avais cela au ca où ca vous aide…

Code:
[/SIZE][/FONT]
[FONT=Arial][I][SIZE=3]ort_Ppt()[/SIZE][/I][/FONT]
[COLOR=teal][FONT=Arial][I][SIZE=3]    'necessite d'activer la reference Microsoft Powerpoint Object Library[/SIZE][/I][/FONT][/COLOR]
[FONT=Arial][I][SIZE=3]    Dim PPT As PowerPoint.Application[/SIZE][/I][/FONT]
[FONT=Arial][I][SIZE=3]    Dim PptDoc As PowerPoint.Presentation[/SIZE][/I][/FONT]
[FONT=Arial][I][SIZE=3]    Dim NbShpe As Byte[/SIZE][/I][/FONT]
[SIZE=3][FONT=Arial][I]    [/I][/FONT][FONT=Arial][I]Dim NumMois As String[/I][/FONT][/SIZE]
[FONT=Arial][I][SIZE=3]    Dim Rep As String[/SIZE][/I][/FONT]
[FONT=Arial][I][SIZE=3]        [/SIZE][/I][/FONT]
[SIZE=3][FONT=Arial][I]    [/I][/FONT][FONT=Arial][I]Sheets("Page de Garde").Select[/I][/FONT][/SIZE]
[FONT=Arial][I][SIZE=3]    NumMois = Range("D14")[/SIZE][/I][/FONT]
[SIZE=3][FONT=Arial][I]    [/I][/FONT][FONT=Arial][I]Rep = Range("D16")[/I][/FONT][/SIZE]
[FONT=Arial][I][SIZE=3]    [/SIZE][/I][/FONT]
[FONT=Arial][I][SIZE=3]    Set PPT = CreateObject("Powerpoint.Application") 'creation session PowerPoint[/SIZE][/I][/FONT]
[SIZE=3][FONT=Arial][I]    [/I][/FONT][FONT=Arial][I]PPT.Visible = True [/I][/FONT][COLOR=teal][FONT=Arial][I]'l'application sera visible[/I][/FONT][/COLOR][FONT=Arial][I][/I][/FONT][/SIZE]
[SIZE=3][FONT=Arial][I]    [/I][/FONT][FONT=Arial][I]Set PptDoc = PPT.Presentations.Open("J:\Services\Finance Division CCF\Reporting-SIDEL\2006\" & Rep & "\Sales report\CCF Division turnover " & NumMois & "-06 Sales Report.ppt") [/I][/FONT][COLOR=teal][FONT=Arial][I]'ouverture fichier ppt[/I][/FONT][/COLOR][FONT=Arial][I][/I][/FONT][/SIZE]
[FONT=Arial][I][SIZE=3]    [/SIZE][/I][/FONT]
[COLOR=teal][FONT=Arial][I][SIZE=3]    ''''''' GRAPHIQUE 30[/SIZE][/I][/FONT][/COLOR]
[FONT=Arial][I][SIZE=3]    Sheets("Division Global Sales").Select[/SIZE][/I][/FONT]
[FONT=Arial][I][SIZE=3]    ActiveSheet.Shapes("Group 30").Copy[/SIZE][/I][/FONT]
[FONT=Arial][I][SIZE=3]    [/SIZE][/I][/FONT]
[FONT=Arial][I][SIZE=3]    PptDoc.Slides(2).Shapes.PasteSpecial ppPasteEnhancedMetafile [/SIZE][/I][/FONT]
[SIZE=3][COLOR=teal][FONT=Arial][I] [/I][/FONT][/COLOR][COLOR=teal][FONT=Arial][I]'collage image metafichier windows dans le Slide3 du document Power Point[/I][/FONT][/COLOR][/SIZE]
[FONT=Arial][I][SIZE=3]    [/SIZE][/I][/FONT]
[FONT=Arial][I][SIZE=3] [/SIZE][/I][/FONT]
[SIZE=3][FONT=Arial][I]    [/I][/FONT][COLOR=teal][FONT=Arial][I]    'compte le nombre de shapes dans le 3eme slide ; le dernier objet inséré correspond à l'index le plus élevé[/I][/FONT][/COLOR][/SIZE]
[SIZE=3][FONT=Arial][I]    [/I][/FONT][FONT=Arial][I]NbShpe = PptDoc.Slides(2).Shapes.Count[/I][/FONT][/SIZE]
[FONT=Arial][I][SIZE=3]    [/SIZE][/I][/FONT]
[FONT=Arial][I][SIZE=3]    With PptDoc.Slides(2).Shapes(NbShpe)[/SIZE][/I][/FONT]
[SIZE=3][FONT=Arial][I]        [/I][/FONT][FONT=Arial][I]'.Name = "monGraph[/I][/FONT][FONT=Arial][I]"                [COLOR=teal]'personnaliser le nom de l'image insérée[/COLOR][/I][/FONT][FONT=Arial][I][/I][/FONT][/SIZE]
[SIZE=3][FONT=Arial][I]        .Left = 100                                  [/I][/FONT][COLOR=teal][FONT=Arial][I]'position horizontale dans le slide[/I][/FONT][/COLOR][FONT=Arial][I][/I][/FONT][/SIZE]
[SIZE=3][FONT=Arial][I]        .Top = 50                               [/I][/FONT][FONT=Arial][I]'[COLOR=teal]position verticale dans le slide[/COLOR][/I][/FONT][FONT=Arial][I][/I][/FONT][/SIZE]
[SIZE=3][FONT=Arial][I]        [/I][/FONT][FONT=Arial][I].Height = 400                             [/I][/FONT][COLOR=teal][FONT=Arial][I]'hauteur image[/I][/FONT][/COLOR][FONT=Arial][I][/I][/FONT][/SIZE]
[SIZE=3][FONT=Arial][I]        .Width = 600                             [/I][/FONT][COLOR=teal][FONT=Arial][I]'largeur image[/I][/FONT][/COLOR][FONT=Arial][I][/I][/FONT][/SIZE]
[FONT=Arial][I][SIZE=3]    End With[/SIZE][/I][/FONT]
[FONT=Arial][I][SIZE=3]    [/SIZE][/I][/FONT]
[FONT=Arial][I][SIZE=3]    [/SIZE][/I][/FONT]
[SIZE=3][FONT=Arial][I]    [/I][/FONT][FONT=Arial][I]PptDoc.Save         [/I][/FONT][COLOR=teal][FONT=Arial][I]'sauvegarder les modifications[/I][/FONT][/COLOR][FONT=Arial][I][/I][/FONT][/SIZE]
[SIZE=3][FONT=Arial][I]    'PptDoc.Close          [/I][/FONT][COLOR=teal][FONT=Arial][I]'fermer le document ppt[/I][/FONT][/COLOR][FONT=Arial][I][/I][/FONT][/SIZE]
[SIZE=3][FONT=Arial][I]    'PPT.Quit '              [/I][/FONT][COLOR=teal][FONT=Arial][I]fermer l'application powerPoint[/I][/FONT][/COLOR][FONT=Arial][I][/I][/FONT][/SIZE]
[FONT=Arial][I][SIZE=3] [/SIZE][/I][/FONT]
[FONT=Arial][I][SIZE=3]End Sub
[/I]
 

MichelXld

XLDnaute Barbatruc
Re : Copier-coller Excel vers Powerpoint (tableaux)

bonjour

Tu peux essayer cette procédure.
La macro copie les plage des 3 premières feuilles du classeur et les colle dans les 3 premieres diapositives de la présentation :


Code:
Sub Test()
   'nécessite d'activer la référence Microsoft Powerpoint Object Library
    Dim PPT As PowerPoint.Application
    Dim PptDoc As PowerPoint.Presentation
    Dim NbShpe As Byte
    Dim i As Integer
 
    Set PPT = CreateObject("Powerpoint.Application")
    PPT.Visible = True 'l'application sera visible
    Set PptDoc = PPT.Presentations.Open("C:\Présentation1.ppt")
 
    'Les plages de cellules des 3 premières feuilles
    For i = 1 To 3
        ThisWorkbook.Worksheets(i).Range("B2:I37").Copy
 
        PptDoc.Slides(i).Shapes.PasteSpecial ppPasteEnhancedMetafile
 
        NbShpe = PptDoc.Slides(i).Shapes.Count
 
        With PptDoc.Slides(i).Shapes(NbShpe)
            '.Name = "NomForme"
            .Left = 100
            .Top = 50
            .Height = 200
            .Width = 350
        End With
    Next i
 
    'PptDoc.Save 'sauvegarder les modifications
    'PptDoc.Close 'fermer le document ppt
    'PPT.Quit 'fermer l'application powerPoint
 
End Sub


bonne journée
michel
Microsoft Excel MVP
 

nat54

XLDnaute Barbatruc
Re : Copier-coller Excel vers Powerpoint (tableaux)

Bonjour Michel,

Alors merci pour t macro mais cela ne fonctionne pas tout à fait correctement :

1/ le pastespecial ne fonctionne pas
je l’ai pour l’instant remplacé par paste
mais j’aimerais en fait un collage special comme image bitmap

2/ pourquoi ca me colle en slide 1 l’onglet 6 et pas les précédents ?
(d’ailleurs j’avais oublié de préciser que mes onglets à copier-coller commencent au 5è (avant ce sont des onglets de travail)

ca marche pour le 6èm mais ensuite débogagr
Shape range : bad argument type
Expected collection index (string or integer)

Merci d’avance
 

MichelXld

XLDnaute Barbatruc
Re : Copier-coller Excel vers Powerpoint (tableaux)

Rebonjour


Alors merci pour t macro mais cela ne fonctionne pas tout à fait correctement :
chez moi ça fonctionne ...

1/ le pastespecial ne fonctionne pas
je l’ai pour l’instant remplacé par paste
chez moi ça fonctionne ... c'est peut être un probleme de version.


2/ pourquoi ca me colle en slide 1 l’onglet 6 et pas les précédents ?

?
dans l'exemple proposé il n'y a pas de 6 eme onglet. tu es sur d'avoir bien adapté la procédure ?


ca marche pour le 6èm mais ensuite débogagr
Shape range : bad argument type
Expected collection index (string or integer)

?


bonne soirée
michel
Microsoft Excel MVP
 

nat54

XLDnaute Barbatruc
Re : Copier-coller Excel vers Powerpoint (tableaux)

Rebonjour
chez moi ça fonctionne ... c'est peut être un probleme de version.
Excel 2000




dans l'exemple proposé il n'y a pas de 6 eme onglet. tu es sur d'avoir bien adapté la procédure ?
Dans mon exemple il y a 30 onglets
(le code que j'avai posté dans mon 1er message était juste pour info si ca pouvait être une base de réflexion, il provient d'un autre fichier)



je viens de retester
j'ai l'impression que la macro colle l'onglet sur le quel je suis lorsque de l'exécution de la macro
et après un copier-coller correct (même si ce n'est pas encore le bon format, on verra ça plus tard..) il me met ce message d'erreur


dois-je coller le code dans un module ou dans thisworkbook ?
 

JNP

XLDnaute Barbatruc
Re : Copier-coller Excel vers Powerpoint (tableaux)

Bonjour Nath54, MichelXLD :),
Tout un WE sans réponse, mais n'oublie pas que c'était la Toussaint et beaucoup sont en déplacement. D'un autre côté, moi même, j'attends toujours une réponse de ta part sur le fil https://www.excel-downloads.com/threads/creer-des-onglets-a-partir-dun-filtre-automatique.105998/ depuis le 26/10 seulement :(...
C'est dommage d'ailleurs parce que si tu adaptes la solution que je t'avais proposée dans le code de Michel
Code:
    'Les plages de cellules des 3 premières feuilles
    For i = 1 To 3
        ThisWorkbook.Worksheets(i).Range("B2:I37").Copy
 
        PptDoc.Slides(i).Shapes.PasteSpecial ppPasteEnhancedMetafile
 
        NbShpe = PptDoc.Slides(i).Shapes.Count
 
        With PptDoc.Slides(i).Shapes(NbShpe)
            '.Name = "NomForme"
            .Left = 100
            .Top = 50
            .Height = 200
            .Width = 350
        End With
    Next i
pour faire une boucle sur toutes les feuilles en ôtant les 5 premières, ça devrait le faire... VS.CodeName te donnera la valeur de i.
Bonne journée :cool:
 

nat54

XLDnaute Barbatruc
Re : Copier-coller Excel vers Powerpoint (tableaux)

Bonjour le fil,

Désolée pour l'autre sujet que je ne suivais plus, finalement je les avais fait à la mano :confused:
mais je garde ton code sous la main

par contre concernant ce fil, je ne comprends pas tout
vs.codename je le mets où ?
le vba je ne suis pas une pro..
 

nat54

XLDnaute Barbatruc
Re : Copier-coller Excel vers Powerpoint (tableaux)

Code:
Sub Test_WS()
   'nécessite d'activer la référence Microsoft Powerpoint Object Library
    Dim PPT As PowerPoint.Application
    Dim PptDoc As PowerPoint.Presentation
    Dim NbShpe As Byte
    Dim i As Integer
    Dim WS As Worksheet
 
 
 
    Set PPT = CreateObject("Powerpoint.Application")
    PPT.Visible = True 'l'application sera visible
    Set PptDoc = PPT.Presentations.Open("I:\DRH\EFFECTIF\Pôles-DRH\Test.ppt")
 
    'Les plages de cellules des 3 premières feuilles
 
       For Each WS In ThisWorkbook.Worksheets
        If WS.Name <> "Absenteisme-LD-LM" And WS.Name <> "Compteurs-82-83" And WS.Name <> "Mensus-2007-2008" And WS.Name <> "Type_poles" Then
         ThisWorkbook.Worksheets(i).Range("B2:I37").Copy
 
        PptDoc.Slides(i).Shapes.Paste ppPasteEnhancedMetafile
 
        NbShpe = PptDoc.Slides(i).Shapes.Count
 
        With PptDoc.Slides(i).Shapes(NbShpe)
            '.Name = "NomForme"
            .Left = 100
            .Top = 50
            .Height = 200
            .Width = 350
        End With
    Next WS
 
    'PptDoc.Save 'sauvegarder les modifications
    'PptDoc.Close 'fermer le document ppt
    'PPT.Quit 'fermer l'application powerPoint
 
End Sub

Là ca me met next sans for .........


au fait concernant collage special
http://support.microsoft.com/kb/164939/fr
 
Dernière édition:

JNP

XLDnaute Barbatruc
Re : Copier-coller Excel vers Powerpoint (tableaux)

Bonsoir Nat54, le forum :),
Peux-t'on se désintéresser d'un fil qu'on a ouvert? Bonne question à étudier dans le salon XLD :p!
Pour revenir à ton problème, tu me donnes le code:
Code:
       For Each WS In ThisWorkbook.Worksheets
        If WS.Name <> "Absenteisme-LD-LM" And WS.Name <> "Compteurs-82-83" And WS.Name <> "Mensus-2007-2008" And WS.Name <> "Type_poles" Then
        ThisWorkbook.Worksheets(i).Range("B2:I37").Copy
        PptDoc.Slides(i).Shapes.Paste ppPasteEnhancedMetafile
        NbShpe = PptDoc.Slides(i).Shapes.Count
        With PptDoc.Slides(i).Shapes(NbShpe)
            '.Name = "NomForme"
            .Left = 100
            .Top = 50
            .Height = 200
            .Width = 350
        End With
    Next WS
Il se trouve déjà que For Each se contente d'un Next (sans le VS), d'où le message d'erreur.
Pour le VS.CodeName, Michel fait référence au nom interne de la feuille (généralement 1, 2, 3... si tu ne les a pas modifiés, ce qui correspond au .CodeName) et non à "Absenteisme-LD-LM" par exemple, nom de la feuille que tu modifie dans l'onglet en direct (et qui correspond à .Name). Du fait, en faisant une boucle en For/Next sur i, il travaille sur les feuilles qui ont pour noms internes 1, 2 et 3. Du fait, il faut intégrer pour garder son code une ligne i=VS.CodeName qui renseignera toutes les fois où il fait appel au CodeName (et non au Name) de la feuille. Soit logiquement le code suivant:
Code:
       For Each WS In ThisWorkbook.Worksheets
        If WS.Name <> "Absenteisme-LD-LM" And WS.Name <> "Compteurs-82-83" And WS.Name <> "Mensus-2007-2008" And WS.Name <> "Type_poles" Then
        [COLOR=red]i = VS.CodeName[/COLOR]
        ThisWorkbook.Worksheets(i).Range("B2:I37").Copy
        PptDoc.Slides(i).Shapes.Paste ppPasteEnhancedMetafile
        NbShpe = PptDoc.Slides(i).Shapes.Count
        With PptDoc.Slides(i).Shapes(NbShpe)
            '.Name = "NomForme"
            .Left = 100
            .Top = 50
            .Height = 200
            .Width = 350
        End With
    [COLOR=red]Next[/COLOR]
qui devrait fonctionner.
Bon courage :cool:
PS: Si tu pouvais utiliser les fonctions en respectant les majuscules (exemple VS.CodeName et non vs.codename), ça améliorerait la lisibilité et la compréhension.
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 889
Membres
101 831
dernier inscrit
gillec