vba - coller range excel dans un nouveau tableau ppt

Bonjour,

Je travaille sur une macro excel qui, va ouvrir un ppt, y ajouter une slide dans laquelle est créé un tableau (6 col, 26 lignes) dans lequel j'aimerai coller de la 2° ligne jusqu'à la dernière un range excel de 6 col et 25 lignes (ça doit occuper chaque cellule du tableau, hormis la 1ère ligne qui est pour les titres) tout en faisant en sorte que le texte copié reste du texte une fois collé.

Or avec le code ci-dessous, les données se collent toutes, mais dans la même cellule.... le problème est vraisemblablement ligne 55

J'ai cru comprendre qu'il fallait procéder avec activewindow.view.pastespecial, mais dans mon cas je pilote ppt depuis excel, donc je ne suis pas sûr que cette méthode fonctionne..

Ne peut-on faire range(cell(2,1), cells(26,6)).pastespecial tout simplement?...

Après je peux toujours boucler, et coller cellule par cellule, mais je pense que cela fait perdre pas mal de temps... non?

En l'attente d'une âme châritable :)

Code:

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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
Option Explicit
    Dim pptApp As powerpoint.Application
    Dim pptDoc As powerpoint.Presentation
    Dim objSld As powerpoint.Slide
    Dim objTbl As powerpoint.Table
    Dim shp As powerpoint.Shape
    Dim chemin As String
    Dim row, col, LigDebut, LigFin As Integer
 
Sub CreerTable()
 
Set pptApp = New powerpoint.Application
 
'chemin du répertoire
chemin = Workbooks(ActiveWorkbook.Name).Path
 
Set pptDoc = pptApp.Presentations.Open(chemin & "test.ppt", withWindow:=msoTrue) 'ouvrir le ptt dans lequel on veut rajouter le tabelau
 
    ' nouvelle slide
    Set objSld = pptDoc.Slides.Add(2, ppLayoutTable)
 
    ' création de la table (5 lignes et  6 colonnes)
    Set objTbl = objSld.Shapes.AddTable(26, 6, 5, 5).Table
 
    With objTbl 'dimensionner les colonnes
        .Columns(1).Width = 50
        .Columns(2).Width = 80
        .Columns(3).Width = 445
        .Columns(4).Width = 55
        .Columns(5).Width = 55
        .Columns(6).Width = 55
    End With
 
    Call FillTable 'remplir le tableau créé
 
    Call SetColors 'tuner son aspect
 
 
End Sub
 
Sub FillTable()
 
        objTbl.Cell(1, 1).Shape.TextFrame.TextRange.Text = "A"
        objTbl.Cell(1, 2).Shape.TextFrame.TextRange.Text = "Z"
        objTbl.Cell(1, 3).Shape.TextFrame.TextRange.Text = "E"
        objTbl.Cell(1, 4).Shape.TextFrame.TextRange.Text = "R"
        objTbl.Cell(1, 5).Shape.TextFrame.TextRange.Text = "T"
        objTbl.Cell(1, 6).Shape.TextFrame.TextRange.Text = "Y"
 
    LigDebut = 1
    LigFin = 25
 
    Sheets("feuil1").Range("L" & LigDebut & ":Q" & LigFin).Copy 'copier 6 colonnes et 25 lignes
 
    objTbl.Cell(2, 1).Shape.TextFrame.TextRange.PasteSpecial ppPasteText 'les coller en ligne 2, 1ère colonne du tableau de 26 lignes et 6 colonnes
    Application.CutCopyMode = False
 
 
End Sub
 
Sub SetColors()
 
    ' je centre le texte horizontalement et verticalement
        For col = 1 To objTbl.Columns.Count          ' pour boucler sur les colonnes
                objTbl.Cell(1, col).Shape.fill.ForeColor.RGB = RGB(0, 102, 204)  '1ère ligne en bleu
                With objTbl.Cell(1, col).Shape.TextFrame
                    .VerticalAnchor = msoAnchorMiddle
                    .HorizontalAnchor = msoAnchorCenter
                    .TextRange.Font.Size = 10
                    .TextRange.Font.Bold = msoTrue
                End With
        Next col
 
 
 
        For row = 2 To objTbl.Rows.Count          ' pour boucler sur les lignes
        objTbl.Rows(row).Height = 8
            For col = 1 To objTbl.Columns.Count    ' pour boucler sur les colonnes
                objTbl.Cell(row, col).Shape.fill.ForeColor.RGB = RGB(255, 255, 255)   'autres lignes en blanc
                Set shp = objTbl.Cell(row, col).Shape
                With shp.TextFrame
                    .VerticalAnchor = msoAnchorMiddle
                    .HorizontalAnchor = msoAnchorCenter
                    .TextRange.Font.Size = 9
                End With
            Next col
        Next row
 
End Sub