[英]Copying objects from powerpoint presentation to Excel, but not pasting in correct range
[英]copying a range in excel pasting in powerpoint
我有这段代码可以复制一个称为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
有谁知道如何做到这一点?
尝试这个
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.