Excel到PowerPoint PasteSpecial并保留源格式

我正在尝试将Excel文档中的一个范围复制并粘贴到PowerPoint幻灯片中

它将范围复制为图像，而不是保留源格式

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

你试过使用吗

oPPTApp.ActiveWindow.View.PasteSpecial DataType:=ppPasteDefault

你试过使用吗

oPPTApp.ActiveWindow.View.PasteSpecial DataType:=ppPasteDefault

---

尝试此解决方案，而不是使用

Shapes.PasteSpecial

方法：

---

这不会创建指向Excel文档的链接，而是将文档的本地副本嵌入到PowerPoint演示文稿中。我想我理解这是您的要求。

尝试此解决方案，而不是使用

形状。粘贴特殊的
方法：


这不会创建指向Excel文档的链接，而是将文档的本地副本嵌入到PowerPoint演示文稿中。我想我明白这是您的要求。
在这种情况下，我一直很乐意使用Excel中的
复制图片。要获取它，请单击
Copy
旁边的箭头

在VBA中，它转换为

Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture

在旧版本的Excel（2003及以前版本）中，您需要单击
Shift+Edit
以获得该选项。
对于这种情况，我一直很乐意在Excel中使用
Copy picture
。要获取它，请单击
Copy
旁边的箭头

在VBA中，它转换为

Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture

在旧版本的Excel（2003及以前版本）中，您需要单击Shift+Edit以获得该选项。
让我们将此问题分成几个不同的部分：


创建PowerPoint应用程序
复制图表粘贴
将图表作为正确的格式

现在看看你的代码，你可以很好地继续前两个。导致问题的是粘贴对象。让我们探索不同的粘贴方式

使用EXECUTEMSO方法：

当我们使用这种方法时，就像我们在幻灯片上单击鼠标右键，然后将对象粘贴到幻灯片上。现在，虽然这种方法是一种完全有效的粘贴方法，但在VBA中实现这一点可能有点挑战性。原因是它非常不稳定，我们必须把脚本的速度放慢到蜗牛的速度


要实现此方法及其任何不同选项，请执行以下操作：

'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"

现在如果你看看我的代码，我不得不暂停两次以确保它能正常工作。这是因为VBA会移动得太快，否则它会在第一张幻灯片上粘贴所有对象如果我们只做一次粘贴，通常不需要暂停，但在你想看新幻灯片的那一刻就可以暂停

使用常规粘贴方法：

当我们使用这种方法时，就像我们按下Crtl+V键一样，它会简单地将对象粘贴为PowerPoint中的常规形状。常规形状表示PowerPoint中的默认粘贴类型。下面是我们如何实现一个简单的粘贴方法：

'PASTE USING PASTE METHOD - NOT AS VOLATILE

'Use Paste method to Paste as Chart Object in PowerPoint
 PPTSlide.Shapes.Paste

使用粘贴特殊方法：

当我们使用这种方法时，就像我们在键盘上按Ctrl+Alt+V一样，我们可以得到各种不同的粘贴选项它的范围从图片一直到嵌入对象，我们可以将其链接回源工作簿。


使用特殊的粘贴方法，有时我们仍然需要暂停脚本。原因与我上面提到的原因一样，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

尽管如此，如果您将一个对象粘贴为一个带有链接的对象，那么大部分时间格式都会随之改变。除非你有一个只存在于Excel中的特殊主题，否则你会遇到麻烦。我在将一张图表从Excel转换到Word时遇到了这个问题，但是Excel图表有一个自定义主题

这是您的代码，已重写，以便使用源格式粘贴对象并设置其尺寸。我希望您不介意我重新调整一些代码，使其更简洁

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

让我们把这个问题分成几个不同的部分：


创建PowerPoint应用程序
复制图表粘贴
将图表作为正确的格式

现在看看你的代码，你可以很好地继续前两个。导致问题的是粘贴对象。让我们探索不同的粘贴方式

使用EXECUTEMSO方法：

当我们使用这种方法时，就像我们在幻灯片上单击鼠标右键，然后将对象粘贴到幻灯片上。现在，虽然这种方法是一种完全有效的粘贴方法，但在VBA中实现这一点可能有点挑战性。原因是它非常不稳定，我们必须把脚本的速度放慢到蜗牛的速度


要实现此方法及其任何不同选项，请执行以下操作：

'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"

现在如果你看看我的代码，我不得不暂停两次以确保它能正常工作。这是因为VBA会移动得太快，否则它会在第一张幻灯片上粘贴所有对象如果我们只做一次粘贴，通常不需要暂停，但在你想看新幻灯片的那一刻就可以暂停

使用常规粘贴方法：

当我们使用这种方法时，就像我们按下Crtl+V键一样，它会简单地将对象粘贴为PowerPoint中的常规形状。常规形状表示PowerPoint中的默认粘贴类型。这里是如何