首先,我的图表被复制为图片,当我尝试粘贴它时,对象不支持此属性或方法错误发生在 行对于 PPTPres.Slides 中的每个 oSh (28) .但最终,我希望将我的图片粘贴在幻灯片 28 的中心,并且稍微小一些。谁能告诉我我在哪里做错了,我应该如何纠正它?
Option Explicit
Sub ExportChartsToPowerPoint_SingleWorksheettesting()
'Declare PowerPoint Variables
Dim PPTApp As Object
Dim PPTPres As Object
Dim PPTShape As Object
Dim mySlide As Object
Dim myslide2 As Object
Dim i As Long
'Declare Excel Variables
Dim Chrt As ChartObject
If PPTApp Is Nothing Then _
Set PPTApp = CreateObject(class:="PowerPoint.Application")
On Error GoTo 0
PPTApp.Visible = True
'Create new presentation in the PowerPoint application.
Set PPTPres = PPTApp.Presentations.Open(Filename:="\\fab2crp-nas1\home22\kkang2\Profile\Desktop\myassignment3\mypresentationsample.pptx")
Dim ppSlide As PowerPoint.Slide
Set ppSlide = PPTPres.Slides(28)
Dim j As Integer
For j = ppSlide.Shapes.Count To 1 Step -1
If ppSlide.Shapes(j).Type = msoPicture Then
ppSlide.Shapes(j).Delete
End If
Next j
With PPTPres.Slides(28)
Sheets(4).Range("A1:M34").CopyPicture
ppSlide.Shapes.Paste
End With
Dim oSh As Shape
For Each oSh In PPTPres.Slides(28) '<---object doesn't support this property or method
With oSh
If .Type = msoLinkedPicture _
Or .Type = msoPicture Then
' position it to taste
.Left = 100
.Top = 100
End If
End With
Next ' Shape
End Sub
目前
预期的
调试打印
最佳答案
试试这个(示例代码):
Sub Tester()
Dim PPTApp As Object
Dim PPTPres As Object
Dim ppSlide As PowerPoint.Slide
Dim Chrt As ChartObject
Dim oSh 'As ShapeRange
Dim pgSet
'using already open PPT for testing....
Set PPTApp = GetObject(, "PowerPoint.Application") 'get open ppt
Set ppSlide = PPTApp.Presentations(1).Slides(1) 'the open presentation
Set pgSet = PPTApp.Presentations(1).PageSetup 'for slide width/height
Sheets(1).Range("A1:M34").CopyPicture
Set oSh = ppSlide.Shapes.Paste() '<< get the pasted shape
'center on slide
With oSh
.Left = (pgSet.SlideWidth - .Width) / 2
.Top = (pgSet.SlideHeight - .Height) / 2
End With
End Sub
关于excel - 如何使用 VBA 将我的图片放置在现有 powerpoint 幻灯片的幻灯片中心?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/60910849/