复制excel中的范围粘贴在powerpoint中答案

【问题标题】：copying a range in excel pasting in powerpoint复制excel中的范围粘贴在powerpoint中
【发布时间】：2016-06-26 09:50:37
【问题描述】：

我有这段代码，它复制一个名为 pastedpic 19 的形状，它是我的 Excel 文件中的形状 17，然后打开一个新的 PowerPoint 幻灯片并粘贴它。问题是我希望它被复制为正常范围并粘贴为这样我就可以在那里更改数据。

Sub exceltoPPT()

Dim PowerPointapp as Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
Dim DestinationSheet7 As Worksheet
Dim DestinationSheet1 As Worksheet

 Dim pastedPic3 As Shape

 Set DestinationSheet1 = Workbooks("1_1_1_tt.xlsm").Sheets("Eingabefeld")
 Set pastedPic9 = DestinationSheet1.Shapes(17)


 ' Create a New Presentation
  Set myPresentation = PowerPointApp.Presentations.Add

 'Add a slide to the Presentation
  Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly


 'pastedPic9.Copy
  Windows(anan).Activate

   Sheets("Eingabefeld").Range("B1:ES44").CopyPicture Appearance:=xlPrinter,Format:=xlPicture

'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial DataType:=2  '2 = ppPasteEnhancedMetafile
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

 'Set position:
   myShape.Left = -15

   myShape.Top = 11

End Sub

有人知道怎么做吗？

【问题讨论】：

标签： vba excel powerpoint

【解决方案1】：

试试这个

Sub Export_xls2pp()
'
'=======================================================================================
' Procedure : Export_xls2pp (Sub)
' Module    : Module1 (Module)
' Project   : VBAProject
' Author    : yann LE DIRACH
' Date      : 11/03/2016
' Comments  : eXPORT XLS RANGE INTO POWERPOINT TABLE
'               ADD REFERENCE TO POPERPOINT LIBRARY (EARLY BINDING)
' Unit Test : () 11/03/2016 10:11 | Description [OK]
' Arg./i    :
'           - [NO PARAM]
'           -
'           -
' Arg./o    : ()
'
'Changes--------------------------------------------------------------------------------
'Date               Programmer                      Change
'11/03/2016         yann LE DIRACH               Initiate
'
'=======================================================================================
'
Dim opp As PowerPoint.Application
Dim oppp As PowerPoint.Presentation
Dim oppps As PowerPoint.Slide
Dim opps_s As PowerPoint.Shape
Dim opps_t As Table
Dim orng As Range

'Note : current xls range
Set orng = ActiveSheet.Range("A1:C6")

'Note : add powerpoint doc
Set opp = CreateObject("Powerpoint.Application")
Set oppp = opp.Presentations.Add

With oppp
    'Note : add slide
    Set oppps = .Slides.Add(1, ppLayoutBlank)
    With oppps
        'Note : add slide > set to table > dim table with xls range settings
        Set opps_s = .Shapes.AddTable(orng.Rows.Count, orng.Columns.Count)
        Set opps_t = opps_s.Table
        'Note : loop throught rng and populate powerpoint table

        For i = 1 To orng.Rows.Count
            For j = 1 To orng.Columns.Count
                opps_t.Cell(i, j).Shape.TextFrame.TextRange.Text = orng.Cells(i, j).Value

            Next j
        Next i

    End With
End With

End Sub

【讨论】：