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 に答える