Excel > ppt : des tableaux et non pas des graphes

**nat54** · 12/11/2008, 16h52

Bonjour,

Je n'a pas de grandes connaissances vba, j'ai cherché des infos à droite à gauche mais je n'arrive pas au résultat escompté

Source : fichier excel, une trentaine d'onglets

Objectif :
> 11 onglets à copier-coller en image type DIB dans un powerpoint
(plage B2 à K49)
> 23 à copier-coller en image type DIB dans un powerpoint
(plage B2 à J37)
Donc certains onglets de travail ne seront pas présent dans le ppt

1/ quelle est la syntaxe pour ce collage spécial ?

2/ comment dire onglet X à copier sur slide x, onglet Y sur slide y ...

J'avais commencé ça mais cela ne fonctionne pas vraiment (pas de collage spécial...)
En plus au départ ca aurait pu fonctionner car plage identique partout donc une boucle était possible mais plus actuellement (2 plages différentes)

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
Sub Test_WS()
   'nécessite d'activer la référence Microsoft Powerpoint Object Library
    Dim PPT As PowerPoint.Application, PptDoc As PowerPoint.Presentation
    Dim NbShpe As Byte, i As Integer, WS As Worksheet
 
    Set PPT = CreateObject("Powerpoint.Application")
    PPT.Visible = True 'l'application sera visible
    Set PptDoc = PPT.ActivePresentation ' PPT.Presentations.Open("I:\DRH\EFFECTIF\Pôles-DRH\Test.ppt")
 
    'Les plages de cellules des 3 premières feuilles
     i = 1
     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" And WS.Name <> "MENU" Then
        WS.Range("B2:I37").Copy
        PptDoc.Slides(i + 1).Shapes.Paste ppPasteEnhancedMetafile
        NbShpe = PptDoc.Slides(i + 1).Shapes.Count
        With PptDoc.Slides(i + 1).Shapes(NbShpe)
            '.Name = "NomForme"
            .Left = 100
            .Top = 50
            .Height = 200
            .Width = 350
        End With
        i = i + 1
        End If
    Next WS
    'PptDoc.Save 'sauvegarder les modifications
    'PptDoc.Close 'fermer le document ppt
    'PPT.Quit 'fermer l'application powerPoint
 End Sub

Merci d'avance