vba Excel 到 PowerPoint PasteSpecial 并保持源格式
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/16338295/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel to PowerPoint PasteSpecial and Keep Source Formatting
提问by user2343123
I'm trying to copy and paste a range from an Excel document into a PowerPoint slide.
我正在尝试将范围从 Excel 文档复制并粘贴到 PowerPoint 幻灯片中。
It is copying the range as an image rather than keeping source formatting.
它将范围复制为图像而不是保留源格式。
oPPTApp As PowerPoint.Application
Dim oPPTFile As PowerPoint.Presentation
Dim oPPTShape As PowerPoint.Shape
Dim oPPTSlide As PowerPoint.Slide
On Error Resume Next
Set XLApp = GetObject(, "Excel.Application")
On Error GoTo 0
Windows("File1.xlsx").Activate
Sheets("Sheet1").Select
Range("B3:N9").Select
Selection.Copy
oPPTApp.ActiveWindow.View.GotoSlide (2)
oPPTApp.ActiveWindow.Panes(2).Activate
oPPTApp.ActiveWindow.View.PasteSpecial DataType:=ppPasteOLEObject
oPPTApp.ActiveWindow.Selection.ShapeRange.Left = 35
oPPTApp.ActiveWindow.Selection.ShapeRange.Top = 150
回答by areed1192
Let's break this problem into a few different parts:
让我们把这个问题分成几个不同的部分：
- Creating the PowerPoint Application
- Copying the Charts Pasting the
- Charts as the right format.
- 创建 PowerPoint 应用程序
- 复制图表粘贴
- 图表作为正确的格式。
Now looking at your code, you are pretty much good to go on the first two. It's pasting the object that is causing the problem. Let's explore the different ways to paste.
现在看看你的代码，你很高兴继续前两个。它正在粘贴导致问题的对象。让我们探索不同的粘贴方式。
USING THE EXECUTEMSO METHOD:
使用 EXECUTEMSO 方法：
When we use this method it's like we are right-clicking on the slide and pasting the object on to the slide. Now while this method is a completely valid way to paste, achieving this in VBA can be a little challenging. The reason why is because it is extremely volatile, and we must slow down our script to a snail's pace!
当我们使用这种方法时，就像我们在幻灯片上单击鼠标右键并将对象粘贴到幻灯片上一样。现在虽然这种方法是一种完全有效的粘贴方式，但在 VBA 中实现这一点可能有点挑战性。原因是因为它极不稳定，我们必须把我们的脚本放慢到蜗牛的速度！
To implement this method along with any of its different options, do the following:
要实现此方法及其任何不同选项，请执行以下操作：
'Create a new slide in the Presentation, set the layout to blank, and paste range on to the newly added slide.
Set PPTSlide = PPTPres.Slides.Add(1, ppLayoutBlank)
'WARNING THIS METHOD IS VERY VOLATILE, PAUSE THE APPLICATION TO SELECT THE SLIDE
For i = 1 To 5000: DoEvents: Next
PPTSlide.Select
'WARNING THIS METHOD IS VERY VOLATILE, PAUSE THE APPLICATION TO PASTE THE OBJECT
For i = 1 To 5000: DoEvents: Next
PPTApp.CommandBars.ExecuteMso "PasteSourceFormatting"
PPTApp.CommandBars.ReleaseFocus
'PASTE USING THE EXCUTEMSO METHOD - VERY VOLATILE
'Paste As Source Formatting
'PPTApp.CommandBars.ExecuteMso "PasteSourceFormatting"
'Paste as Destination Theme
'PPTApp.CommandBars.ExecuteMso "PasteDestinationTheme"
'Paste as Embedded Object
'PPTApp.CommandBars.ExecuteMso "PasteAsEmbedded"
'Paste Excel Table Source Formatting
'PPTApp.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
'Paste Excel Table Destination Theme
'PPTApp.CommandBars.ExecuteMso "PasteExcelTableDestinationTableStyle"
Now if you look at my code, I had to pause it two different times to make sure it would work. This is because VBA will move way too fast otherwise and all that will happen is it will paste all the objects on the first slide! If we are only doing one paste we are usually safe without putting in the pauses, but the minute you want to go to a new slide put the pauses in!
现在，如果您查看我的代码，我不得不将其暂停两次以确保它可以正常工作。这是因为 VBA 会移动得太快，否则会发生的事情就是它将所有对象粘贴到第一张幻灯片上！如果我们只做一个粘贴，我们通常是安全的，不用停顿，但是当你想转到一张新幻灯片时，停顿一下！
USING THE REGULAR PASTE METHOD:
使用常规粘贴方法：
When we use this method, it's like we are pressing Crtl+V and it will simply paste the object as a regular shape in PowerPoint. The regular shape means the default paste type in PowerPoint. Here is how we can implement a simple paste method:
当我们使用这种方法时，就像我们按下了 Crtl+V 一样，它会简单地将对象粘贴为 PowerPoint 中的常规形状。常规形状表示 PowerPoint 中的默认粘贴类型。下面是我们如何实现一个简单的粘贴方法：
'PASTE USING PASTE METHOD - NOT AS VOLATILE
'Use Paste method to Paste as Chart Object in PowerPoint
PPTSlide.Shapes.Paste
USING THE PASTE SPECIAL METHOD:
使用粘贴特殊方法：
When we use this method it's like we are pressing Ctrl+Alt+Von the keyboard and we get all sorts of different options of how to paste it. It ranges from a picture all the way to an embedded object that we can link back to the source workbook.
当我们使用这种方法时，就像我们在键盘上按下Ctrl+ Alt+一样V，我们会得到各种不同的粘贴选项。它的范围从图片一直到我们可以链接回源工作簿的嵌入对象。
With the paste special method, sometimes we will still have to pause our scripts.The reason why is like the reason I mentioned above, VBA is volatile. Just because we copy it doesn't mean it will make it to our clipboard. This problem can pop up and then disappear at the same time, so our best bet is to have a pause in our script to give VBA enough time to put the information in the clipboard.It usually doesn't have to be a long pause but only a second or 2. Here is how we implement the paste special method with the different options we can use:
使用粘贴特殊方法，有时我们仍然需要暂停我们的脚本。原因就像我上面提到的原因，VBA 是不稳定的。仅仅因为我们复制它并不意味着它会进入我们的剪贴板。这个问题可能会同时出现然后消失，所以我们最好的办法是在我们的脚本中暂停一下，让 VBA 有足够的时间将信息放入剪贴板。通常不需要很长时间的停顿，只要一两秒钟。 以下是我们如何使用我们可以使用的不同选项来实现粘贴特殊方法：
'PASTE USING PASTESPECIAL METHOD - NOT AS VOLATILE
'Paste as Bitmap
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteBitmap
'Paste as Default
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteDefault
'Paste as EnhancedMetafile
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
'Paste as HTML - DOES NOT WORK WITH CHARTS
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteHTML
'Paste as GIF
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteGIF
'Paste as JPG
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteJPG
'Paste as MetafilePicture
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteMetafilePicture
'Paste as PNG
PPTSlide.Shapes.PasteSpecial DataType:=ppPastePNG
'Paste as Shape
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteShape
'Paste as Shape, display it as an icon, change the icon label, and make it a linked icon.
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteShape, DisplayAsIcon:=True, IconLabel:="Link to my Chart", Link:=msoTrue
'Paste as OLEObject and it is linked.
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteOLEObject, Link:=msoFalse
With all that being said, if you paste an object as an OLEObject with a link most of the time the formatting comes over with it. Unless you have a special theme that only exist in Excel, that's where you get into trouble. I ran into this problem when I was taking a chart from Excel To Word, but the Excel chart had a custom theme.
尽管如此，如果您将对象粘贴为 OLEObject 并在大多数情况下带有链接，则格式会随之而来。除非您有一个仅存在于 Excel 中的特殊主题，否则您就会遇到麻烦。我在从 Excel 到 Word 获取图表时遇到了这个问题，但 Excel 图表有一个自定义主题。
Here is your code, rewritten so that it will paste an object using the source format and setting the dimensions of it.I hope you don't mind me readjusting some of your code to make it a little more concise.
这是您的代码，重写后将使用源格式粘贴对象并设置其尺寸。我希望你不介意我重新调整你的一些代码，使它更简洁一些。
Sub PasteRangeIntoPowerPoint()
'Declare your variables
Dim oPPTApp As PowerPoint.Application
Dim oPPTFile As PowerPoint.Presentation
Dim oPPTShape As PowerPoint.Shape
Dim oPPTSlide As PowerPoint.Slide
Dim Rng As Range
'Get the PowerPoint Application, I am assuming it's already open.
Set oPPTApp = GetObject(, "PowerPoint.Application")
'Set a reference to the range you want to copy, and then copy it.
Set Rng = Worksheets("Sheet1").Range("B3:N9")
Rng.Copy
'Set a reference to the active presentation.
Set oPPTFile = oPPTApp.ActivePresentation
'Set a reference to the slide you want to paste it on.
Set oPPTSlide = oPPTFile.Slides(3)
'WARNING THIS METHOD IS VERY VOLATILE, PAUSE THE APPLICATION TO SELECT THE SLIDE
For i = 1 To 5000: DoEvents: Next
oPPTSlide.Select
'WARNING THIS METHOD IS VERY VOLATILE, PAUSE THE APPLICATION TO PASTE THE OBJECT
For i = 1 To 5000: DoEvents: Next
oPPTApp.CommandBars.ExecuteMso "PasteSourceFormatting"
oPPTApp.CommandBars.ReleaseFocus
For i = 1 To 5000: DoEvents: Next
'Set the dimensions of your shape.
With oPPTApp.ActiveWindow.Selection.ShapeRange
.Left = 35
.Top = 150
End With
End Sub
回答by Patrick Honorez
For that case, I have always been happy using Copy picturein Excel. To get it, click the arrow next to Copy.
In VBA, it translates to
对于这种情况，我一直很高兴Copy picture在 Excel 中使用。要获取它，请单击旁边的箭头Copy。
在 VBA 中，它转换为
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
In older versions of Excel (2003 and previous) you need to click Shift+Editto get that option.
在旧版本的 Excel（2003 及更早版本）中，您需要单击Shift+Edit以获取该选项。
回答by WhiskeyTangoFiretruck
This is a code of mine that Keeps Source Formatting:
这是我的保持源格式的代码：
Sub SigAcc()
Application.ScreenUpdating = False
Dim myPresentation As Object
Set myPresentation = CreateObject("PowerPoint.Application")
Dim PowerPointApp As Object
Dim PPTApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Set objPPApp = New PowerPoint.Application
Set PPSlide = myPresentation.ActivePresentation.Slides(2)
lastrow = ThisWorkbook.Worksheets("The worksheet you would like to copy").Range("Letter of longest column (E.I. "A")" & Rows.Count).End(xlUp).Row
For p = PPSlide.Shapes.Count To 1 Step -1
Set myShape = PPSlide.Shapes(p)
If myShape.Type = msoPicture Then myShape.Delete
Next
Set myPresentation = myPresentation.ActivePresentation
Set mySlide = myPresentation.Slides(2)
On Error Resume Next
'assigning range into variable
Set r = ThisWorkbook.Worksheets("Sheet to copy").Range("A1:C" & lastrow)
On Error Resume Next
'If we have already opened powerpoint
Set PowerPointApp = GetObject(Class:="PowerPoint.Application")
'If Powerpoint is not opened
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(Class:="Powerpoint.Application")
r.Copy
'to paste range
PPApp.CommandBars.ExecuteMso ("PasteSourceFormatting")
mySlide.Shapes.PasteSpecial
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
'Set position:
myShape.left = ActivePresentation.PageSetup.SlideWidth / 2 - ActivePresentation.PageSetup.SlideWidth / 2
myShape.Top = 80
PowerPointApp.Visible = True
PowerPointApp.Activate
'to clear the cutcopymode from clipboard
Application.CutCopyMode = False
End Sub
回答by user1651402
Have you tried using
你有没有试过使用
oPPTApp.ActiveWindow.View.PasteSpecial DataType:=ppPasteDefault
回答by David Zemens
Try this solution instead of using the Shapes.PasteSpecialmethod:
试试这个解决方案，而不是使用以下Shapes.PasteSpecial方法：
https://stackoverflow.com/a/19187572/1467082
https://stackoverflow.com/a/19187572/1467082
PPTApp.CommandBars.ExecuteMso "PasteExcelChartSourceFormatting"
This does not create a link to the Excel document, it embeds a local copy of the document in the PowerPoint Presentation. I think I understand this is your requirement.
这不会创建 Excel 文档的链接，而是在 PowerPoint 演示文稿中嵌入文档的本地副本。我想我明白这是你的要求。
