尝试在 PowerPoint 中将对象转换为图像时出现"错误 -2147188160 (80048240) 形状 (未知成员): 无效请求"。



我是一个新的stackoverflow用户,所以我不确定我做得是否正确,但我试图发布一个关于Steve Rindsberg之前给出的解决方案的问题。我没有足够的声誉来评论,而且似乎没有办法直接给另一个用户发消息,所以我在这里发布了一个新问题。

我似乎无法使下面的代码正常工作。我使用的是PowerPoint O365 1901版,我有两种类型的形状要转换,msoChart和msoLinkedOLEObject(一些Excel工作表)。我最初将ppPasteEnhancedMetafile更改为ppPasteNG,因为我想要PNG,但两者都失败了。

这是代码:

Sub ConvertAllShapesToPic()
Dim oSl As Slide
Dim oSh As Shape
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
' modify the following depending on what you want to
' convert
Select Case oSh.Type
Case msoChart, msoEmbeddedOLEObject, msoLinkedOLEObject
ConvertShapeToPic oSh
Case msoPlaceholder
If oSh.PlaceholderFormat.ContainedType = msoEmbeddedOLEObject _
Or oSh.PlaceholderFormat.ContainedType = msoLinkedOLEObject _
Or oSh.PlaceholderFormat.ContainedType = msoChart _
Then
ConvertShapeToPic oSh
End If
Case Else
End Select
Next
Next
End Sub
Sub ConvertShapeToPic(ByRef oSh As Shape)
Dim oNewSh As Shape
Dim oSl As Slide
Set oSl = oSh.Parent
oSh.Copy
Set oNewSh = oSl.Shapes.PasteSpecial(ppPastePNG)(1)
With oNewSh
.Left = oSh.Left
.Top = oSh.Top
Do
.ZOrder (msoSendBackward)
Loop Until .ZOrderPosition < oSh.ZOrderPosition
End With
oSh.Delete
End Sub

我注意到,如果我在幻灯片放映模式下从链接/操作运行ConvertAllShapesToPic,它不会完成,而是以静默方式失败。如果我添加一个命令按钮(ActiveX控件)并从那里运行它,我会得到以下内容:

运行时错误"-2147188160(80048240)":

形状(未知成员):请求无效。指定的数据类型不可用。

它在Set oNewSh=sld上失败。Shapes.PasteSpecial(ppPasteNG)(1)。出错后,如果我回到幻灯片并按Ctrl-V,我会得到图像,所以我知道它一直在工作。

我已经尝试了我在网上找到的各种解决方案,比如添加DoEvents或ActiveWindow.Panes(1)。复制后激活,但似乎没有什么区别。有什么建议吗?

感谢

我找到了一些其他代码来转换图表,然后我断开了工作表上的链接,这会自动将它们转换为图像。

我发现的一件事是,您必须退出幻灯片放映模式才能断开msoLinkedOLEObject链接。我不能百分之百确定为什么。。。但这是适用于我的代码:

Sub DoStuff()
Call LinkedGraphsToPictures
ActivePresentation.SlideShowWindow.View.Exit
Call BreakAllLinks
End Sub

Sub LinkedGraphsToPictures()
Dim shp As Shape
Dim sld As Slide
Dim pic As Shape
Dim shp_left As Double
Dim shp_top As Double
For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.Type = msoChart Then
'Retrieve current positioning
shp_left = shp.Left
shp_top = shp.Top
'Copy/Paste as Picture
shp.Copy
DoEvents
sld.Shapes.PasteSpecial DataType:=ppPastePNG
Set pic = sld.Shapes(sld.Shapes.Count)
'Delete Linked Shape
shp.Delete
'Reposition newly pasted picture
pic.Left = shp_left
pic.Top = shp_top
End If
Next shp
Next sld
End Sub

Sub BreakAllLinks()
Dim shp As Shape
Dim sld As Slide
For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.Type = msoLinkedOLEObject Then
shp.LinkFormat.BreakLink
End If
Next shp
Next sld
End Sub

最新更新