1

这是我编写的将图片从 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
4

1 回答 1

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
于 2015-07-24T00:53:37.103 回答