正在将图片从 Excel 复制到 Powerpoint

Question

这是我编写的用于将图片从 Excel 复制到 PowerPoint 的代码。我有其他代码准备 PowerPoint 幻灯片，这应该与此无关。由于某种原因，此代码不起作用。它给我的错误是当前没有幻灯片在视图中。在此先感谢您的帮助。

Sub CopyPicToPPt()

Dim pptApp As PowerPoint.Application
Dim pptPresent  As Presentation
Dim sldPPT  As Slide
Dim shpPic As Shape
Dim oLayout As CustomLayout
Dim x As PowerPoint.Shape

ActiveWorkbook.Sheets("Sheet1").Select
Set shpPic = Sheet4.Shapes("Picture 3") '<< --- Pic Name

shpPic.CopyPicture

Set pptApp = GetObject(class:="PowerPoint.Application")

pptApp.Visible = True
pptApp.Activate

Set pptPresent = pptApp.ActivePresentation
Set sldPPT = pptApp.ActiveWindow.View.Slide



sldPPT.Shapes.PasteSpecial(ppPasteMetafilePicture).Select

pptApp.ActiveWindow.Selection.ShapeRange.LockAspectRatio = False
pptApp.ActiveWindow.Selection.ShapeRange.Left = 24
pptApp.ActiveWindow.Selection.ShapeRange.Top = 6
pptApp.ActiveWindow.Selection.ShapeRange.Height = 55
pptApp.ActiveWindow.Selection.ShapeRange.width = 672


End Sub

Answer 1

经过一点点摆弄和朋友的帮助，我想我已经做到了！ - 干杯

Sub CopyPicToPPt()

Dim pptApp As PowerPoint.Application
Dim pptPresent  As Presentation
Dim sldPPT  As Slide
Dim shpPic As Shape
Dim oLayout As CustomLayout
Dim x As PowerPoint.Shape

ActiveWorkbook.Sheets("Sheet1").Visible = True
ActiveWorkbook.Sheets("Sheet1").Select
Set shpPic = Sheet4.Shapes("Picture 3") '<< --- Pic Name

shpPic.CopyPicture

Set pptApp = GetObject(class:="PowerPoint.Application")

pptApp.Visible = True
pptApp.Activate

pptApp.ActivePresentation.Slides(1).Select

Set pptPresent = pptApp.ActivePresentation
Set sldPPT = pptApp.ActivePresentation.Slides(1)



sldPPT.Shapes.PasteSpecial(ppPasteMetafilePicture).Select

pptApp.ActiveWindow.Selection.ShapeRange.LockAspectRatio = False
pptApp.ActiveWindow.Selection.ShapeRange.Left = 24
pptApp.ActiveWindow.Selection.ShapeRange.Top = 6
pptApp.ActiveWindow.Selection.ShapeRange.Height = 55
pptApp.ActiveWindow.Selection.ShapeRange.width = 672
ActiveWorkbook.Sheets("Sheet1").Visible = False

End Sub

正在将图片从 Excel 复制到 Powerpoint

Copying picture from Excel to Powerpoint

vba

copying

pasting