作者foolkids (翼をください)
看板Office
标题[算表] 透由VBA复制Excel储存格到PPT的指令(内详)
时间Tue Jul 4 15:42:20 2017
软体: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
--
┌─────────────────────────────┐
│就这样，终於到了启程的日子。
│
│和来机场送行的朋友们说着玩笑话，其实内心恍恍惚惚像在作梦。
│
│也似乎是因为，
为了走到「出发」这一步，耗尽了全部心力。 │
└─────────────────石田裕辅《不去会死！》─┘
--
※ 发信站: 批踢踢实业坊(ptt.cc), 来自: 223.137.40.168
※ 文章网址: https://webptt.com/cn.aspx?n=bbs/Office/M.1499154145.A.5B2.html
1F：→ soyoso: datatype改为0，看是否是原po要的 07/04 15:59
2F：→ foolkids: S大，0会卡住，没办法续行耶 07/04 16:18
3F：→ soyoso: 那将myslide.shapes.pastespecial这行改为 07/04 16:43
4F：→ soyoso: powerpointapp.commandbars.executemso ("PasteSourceForm 07/04 16:46
5F：→ soyoso: atting") 07/04 16:46
6F：→ foolkids: 程序呼叫或引述不正确，好像参数不能这样加上去，因为括 07/04 16:51
7F：→ foolkids: 号前面出现了空格 07/04 16:51
8F：→ foolkids: 测试复制一个slide可行，但是复制Range还是不行 07/04 17:00
10F：→ foolkids: … 奇怪，为何我会卡住… 我再试试看，谢谢S大！ 07/04 18:13
11F：→ foolkids: 发现要加Application.Wait那行才行… 总算成功了， 07/04 18:19
12F：→ foolkids: 可是不是很稳，最稳的方式是停在PowerPointApp那行， 07/04 18:31
13F：→ foolkids: 手动继续执行… 这是什麽问题？ 07/04 18:31
14F：→ foolkids: 後来透由Shapes.count进行卡控回圈，终於解决了… 07/04 19:27
15F：→ foolkids: 结果有了新的问题... 这样复制过来的Shape无法使用 07/04 21:10
16F：→ foolkids: Shape.ScaleWidth或是Shape.ScaleHeight的方法，有解吗? 07/04 21:12
17F：→ soyoso: 以shape.width和height来调整试试 07/05 07:10
18F：→ foolkids: 好喔，应该可行，只是又要大改，哈哈 07/05 07:58
19F：→ foolkids: 欸… Shape.width = Shape.wIdth * ScaleRate 就好了… 07/05 08:33
※ 编辑: foolkids (223.140.240.10), 07/05/2017 08:37:28