Discussion :

[letienne]

Bonjour,

je cherche à reproduire l'action copier-coller d'une plage de cellule d'Excel vers PowerPoint.

Lorsqu'il s'agit d'un graphique, pas de problème, l'action Shapes.PasteSpecial(ppPasteShape) reproduit la même action que si l'on fait le copier coller à la main, c'est à dire que le graphique s'adapte à la taille qu'on lui donne sans problème de mise en page.
En revanche s'il s'agit d'un range, il est possible soit de l'importer comme image, soit de l'importer comme OLEObject, dans les deux cas le ratio largeur/hauteur se fige ce qui donne des texte écrasés ou étirés mais pas le même résultat que lors du copier/coller manuel.

En espérant avoir été clair...

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
 
'Morceau d'une procédure qui copie quelque chose d'excel vers PowerPoint
If obj Is Nothing Then 'si rien ajout d'une zone de texte vide
        Set Forme = mySlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 10, 10, 10, 10)
    Else
        obj.Copy
        If TypeOf obj Is Range Then
            Set Forme = mySlide.Shapes.PasteSpecial(ppPasteOLEObject, Link:=msoFalse)
        Else
            Set Forme = mySlide.Shapes.PasteSpecial(ppPasteShape, Link:=msoFalse)
        End If
 
    End If
    With Forme
        .Left = 120
        .Top = 60
        .Height = 100
        .Width = 590
    End With

letienne

[clementmarcotte]

Bonjour,

C'est indiqué ici que le collage spécial de PowerPoint donne un objet ShapeRange


On peut définir le redimensionnement d'un objet Shaperange

avec ShapeRange.scaleheight
et ShapeRange.scalewidth

[letienne]

Bonjour,
merci pour la réponse, mais à priori ça ne fonctionne pas.
Lorsque je copie une plage de cellules Excel avec Paste ou PasteSpecial en gardant la valeur par défaut (soit shaperange), j'ai le message d'erreur suivant : "Clipboard is empty or do not contain data which may not be pasted here."
ça marche uniquement avec OleObject ou image.

letienne

[letienne]

Finalement j'ai rien trouvé donc j'ai écrit une petite fonction qui copie les cellules une à une.
La voici si ça intéresse quelqu'un.
S'il existe une fonction native je suis toujours preneur ^^
Avec cette fonction je perds les bordures de cellules, il est possible sans doute de les récupérer mais c'est lourd je le ferais plus tard peut être.

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
31
32
33
34
35
36
37
38
39
40
41
42
43
 
Function RangeCopyToPPT(myRange As Range, mySlide As PowerPoint.Slide) As PowerPoint.Shape
    Dim l_max As Integer, c_max As Integer, l As Integer, c As Integer
    Dim Forme As PowerPoint.Shape
    Dim MonAlignement As Long
 
    l_max = myRange.Rows.count
    c_max = myRange.Columns.count
    'Ajout d'un tableau
    Set Forme = mySlide.Shapes.AddTable(l_max, c_max)
    Forme.Table.FirstRow = False
    Forme.Table.HorizBanding = False
 
    For l = 1 To l_max
        For c = 1 To c_max
            'Copie des valeurs
            If myRange.Cells(l, c).NumberFormat <> "General" Then 'Récupération du format des nombres
                Forme.Table.Cell(l, c).Shape.TextFrame.TextRange.Text = Format(myRange.Cells(l, c), myRange.Cells(l, c).NumberFormat)
            Else
                Forme.Table.Cell(l, c).Shape.TextFrame.TextRange.Text = myRange.Cells(l, c)
            End If
            'Copie de la mise en forme
            Forme.Table.Cell(l, c).Shape.Fill.ForeColor.RGB = myRange.Cells(l, c).Interior.Color
            Forme.Table.Cell(l, c).Shape.TextFrame.TextRange.Font.Name = myRange.Cells(l, c).Font.Name
            Forme.Table.Cell(l, c).Shape.TextFrame.TextRange.Font.Size = myRange.Cells(l, c).Font.Size
            Forme.Table.Cell(l, c).Shape.TextFrame.TextRange.Font.Color = myRange.Cells(l, c).Font.Color
            'Récupération alignement
            Select Case myRange.Cells(l, c).HorizontalAlignment
                Case xlLeft
                    MonAlignement = ppAlignLeft
                Case xlRight
                    MonAlignement = ppAlignRight
                Case Else
                    MonAlignement = ppAlignCenter
            End Select
 
            Forme.Table.Cell(l, c).Shape.TextFrame.TextRange.ParagraphFormat.Alignment = MonAlignement
 
        Next c
    Next l
 
    Set RangeCopyToPPT = Forme
End Function