[算表] 透由VBA复制Excel储存格到PPT的指令(内详)

楼主: foolkids (翼をください)   2017-07-04 15:42:20
软件:MS Office
版本:2010
一般在Excel直接选择一特定范围(例如A1:C12)复制并于PPT贴上时,会产生一个类似表格的物件,
可快速进行简易编辑
但是透由宏贴上时,却会变成一个内嵌的Excel档案,如果要编辑的时候就会切换成一个类似Excel的编辑器
有办法透由宏贴上一个简易的表格物件吗?
目前的测试宏内容如下:
Option Explicit
Sub ExcelRangeToPowerPoint()
'PURPOSE: Copy/Paste An Excel Range Into a New PowerPoint Presentation
'SOURCE: www.TheSpreadsheetGuru.com
Dim rng As Range
Dim PowerPointApp As Object, myPresentation As Object, mySlide As Object, myShape As Object
'Copy Range from Excel
Set rng = ThisWorkbook.ActiveSheet.Range("A1:C12")
'Create an Instance of PowerPoint
On Error Resume Next
'Is PowerPoint already opened?
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
'Clear the error between errors
Err.Clear
'If PowerPoint is not already open then open PowerPoint
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
'Optimize Code
Application.ScreenUpdating = False
'Create a New Presentation
Set myPresentation = PowerPointApp.Presentations.Add
'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly
'Copy Excel Range
rng.Copy
'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial DataType:=10 ' 2 = ppPasteEnhancedMetafile
'10 = ppPasteOLEObject
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
'Set position:
myShape.Left = 66
myShape.Top = 152
'Make PowerPoint Visible and Active
PowerPointApp.Visible = True
PowerPointApp.Activate
'Clear The Clipboard
Application.CutCopyMode = False
End Sub
作者: soyoso (我是耀宗)   2017-07-04 15:59:00
datatype改为0,看是否是原po要的
楼主: foolkids (翼をください)   2017-07-04 16:18:00
S大,0会卡住,没办法续行耶
作者: soyoso (我是耀宗)   2017-07-04 16:43:00
那将myslide.shapes.pastespecial这行改为powerpointapp.commandbars.executemso ("PasteSourceFormatting")
楼主: foolkids (翼をください)   2017-07-04 16:51:00
程序呼叫或引述不正确,好像参数不能这样加上去,因为括号前面出现了空格测试复制一个slide可行,但是复制Range还是不行
作者: soyoso (我是耀宗)   2017-07-04 17:38:00
https://youtu.be/XcsfWAi0qiE 回文,executemso的测试
楼主: foolkids (翼をください)   2017-07-04 18:13:00
… 奇怪,为何我会卡住… 我再试试看,谢谢S大!发现要加Application.Wait那行才行… 总算成功了,可是不是很稳,最稳的方式是停在PowerPointApp那行,手动继续执行… 这是什么问题?后来透由Shapes.count进行卡控循环,终于解决了…结果有了新的问题... 这样复制过来的Shape无法使用Shape.ScaleWidth或是Shape.ScaleHeight的方法,有解吗?
作者: soyoso (我是耀宗)   2017-07-05 07:10:00
以shape.width和height来调整试试
楼主: foolkids (翼をください)   2017-07-05 07:58:00
好喔,应该可行,只是又要大改,哈哈欸… Shape.width = Shape.wIdth * ScaleRate 就好了…

Links booklink

Contact Us: admin [ a t ] ucptt.com