将图表从Excel转移到幻灯片上的特定位置

将图表从Excel转移到幻灯片上的特定位置,excel,vba,Excel,Vba,我有一个vba代码将对象/范围从Excel传输到PowerPoint。幻灯片上粘贴数据的所有结果都位于幻灯片的中心。在这种情况下,我希望将每个对象粘贴到幻灯片上的某个位置(例如:在幻灯片的左角、顶部、底部等)。请帮帮我, 我使用的代码是: 'List Slides PPT MySlideArray = Array(5, 7, 7, 12, 21, 25, 27, 28, 8, 14, 23, 8, 16, 24, 10, 17, 10, 19, 31, 31, 31, 45, 45, 45)

我有一个vba代码将对象/范围从Excel传输到PowerPoint。幻灯片上粘贴数据的所有结果都位于幻灯片的中心。在这种情况下,我希望将每个对象粘贴到幻灯片上的某个位置(例如:在幻灯片的左角、顶部、底部等)。请帮帮我, 我使用的代码是:

'List Slides PPT
  MySlideArray = Array(5, 7, 7, 12, 21, 25, 27, 28, 8, 14, 23, 8, 16, 24, 10, 17, 10, 19, 31, 31, 31, 45, 45, 45)

'List range that want to be transferred to slide
    MyRangeArray = Array(Sheets("Dashboard IM").Range("B6:I14"), Sheets("Dashboard IM").Range("B17:L23"), _
      Sheets("Dashboard IM").Range("B25:H31"), Sheets("Dashboard IM").Range("B34:L56"), Sheets("Dashboard IM").Range("O41:T61"), _
      Sheets("Dashboard IM").Range("O17:S22"), Sheets("Dashboard IM").Range("O25:S30"), Sheets("Dashboard IM").Range("O34:S38"), _
      Sheets("Dashboard IM").Range("W6:AC11"), Sheets("Dashboard IM").Range("W15:AE36"), Sheets("Dashboard IM").Range("W40:AE46"), _
      Sheets("Dashboard IM").Range("AG6:AN11"), Sheets("Dashboard IM").Range("AG15:AL36"), Sheets("Dashboard IM").Range("AQ41:AV60"), _
      Sheets("Dashboard IM").Range("BA6:BI11"), Sheets("Dashboard IM").Range("BA15:BF36"), _
      Sheets("Dashboard IM").Range("BM6:BU11"), Sheets("Dashboard IM").Range("BM15:BU36"), _
      Sheets("Dashboard EPI (2)").Range("E19:N29"), Sheets("Dashboard EPI (2)").Shapes("Chart 4"), Sheets("Dashboard EPI (2)").Shapes("Chart 5"), _
      Sheets("Dashboard CIP").Range("E19:M26"), Sheets("Dashboard CIP").Shapes("Chart 1"), Sheets("Dashboard CIP").Shapes("Chart 9"))

'Loop through Array data
  For x = LBound(MySlideArray) To UBound(MySlideArray)
    'Copy Excel Range
    On Error Resume Next
        MyRangeArray(x).Copy
    
        
    'Paste to PowerPoint and position
      On Error Resume Next
        Set shp = myPresentation.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=2) 'Excel 2007-2010
        Set shp = PowerPointApp.ActiveWindow.Selection.ShapeRange 'Excel 2013
      On Error GoTo 0
     
  Next x```