Excel / PowerPoint - 在远程应用程序中旋转 3D 模型

Question

如果我将 3D 模型添加到 Excel 工作表中，那么我可以使用代码来旋转它...

ActiveSheet.Shapes("modGrating").Model3D.IncrementRotationY 10

如果我在PPT中有3D模型，那么我可以使用代码来旋转它......

ActivePresentation.Slides(1).Shapes("modGrating").Model3D.IncrementRotationY 10

但是，如果我尝试在通过 Excel 打开的 PPT 演示文稿中旋转 3D 模型，则会出错...

Dim ppt As PowerPoint.Application
Dim prs As PowerPoint.Presentation
Set ppt = CreateObject("PowerPoint.Application")
With ppt
    .Visible = True
    .WindowState = ppWindowMaximized
    Set prs = Nothing
    On Error Resume Next
    Set prs = .Presentations.Open(ThisWorkbook.Path & "\TestFile.pptm", msoFalse, msoTrue, msoTrue)
    On Error GoTo 0
    prs.Slides(1).Shapes("modGrating").Model3D.IncrementRotationY 10
    .Activate
End With
Set prs = Nothing
Set ppt = Nothing

错误是“运行时错误'430'：”“类不支持自动化或不支持预期的接口”

我可以对该形状做任何我喜欢的事情，但我无法访问 3D 模型格式。

有人熟悉这个问题吗？有什么办法可以解决吗？

我制作了几个示例文件来演示该问题。不过，假设我可以，不确定如何在此处附加这些内容。

在我的电脑和笔记本电脑上，它都会以同样的方式失败。两者都运行最新版本的 MS 365。

谢谢

西蒙

Answer 1

来自盗贼...

显然我无法通过 StackOverflow 共享文件，所以这里是如何进行测试......

启动一个新的 Excel 工作簿并将其作为 .xlsm 文件保存在桌面上。

打开 VBA IDE 并添加 Microsoft PowerPoint 作为参考

在新模块中添加以下代码

Public Sub Test3DinPPT()

Dim ppt As PowerPoint.Application
Dim prs As PowerPoint.Presentation

Set ppt = CreateObject("PowerPoint.Application")

With ppt
    .Visible = True
    .WindowState = ppWindowMaximized
    Set prs = .Presentations.Open(ThisWorkbook.Path & "\TestFile.pptx", msoFalse, msoTrue, msoTrue)
    prs.Slides(1).Shapes("modGrating").Model3D.IncrementRotationY 10
    .Activate
End With

Set prs = Nothing
Set ppt = Nothing

End sub

开始一个新的 PowerPoint 演示文稿并清除幻灯片 1 中的所有内容。添加一个 3D 模型，任何人都会这样做，并将其命名为 modGrating。

将文件另存为 TestFile.pptx 在桌面上（或放置 Excel 文件的任何位置）。

关闭并退出 PPT。

运行 Excel 代码。它应该在 IncrementRotation 线上失败。

为了证明代码完全可以工作，您可以将 3D 模型添加到 Excel 工作表中，将其命名为 modGrating 并运行此过程...

Public Sub RotateGrating()

ActiveSheet.Shapes("modGrating").Model3D.IncrementRotationY 10

End Sub

形状会移动一点

感谢您的帮助！

Answer 2

• 旋转之前，请确保选择形状。
• 使用 shp 作为变体而不是 PowerPoint.Shape 以避免 430 错误（根本原因不确定）。

Option Explicit
' Excel VBA code, Early binding PowerPoint 16.0
Public Sub Test3DinPPT()
    Dim ppt As PowerPoint.Application
    Dim prs As PowerPoint.Presentation
    Dim shp ' As PowerPoint.Shape
    Set ppt = CreateObject("PowerPoint.Application")
    'Set ppt = GetObject(, "PowerPoint.Application")
    With ppt
        .Visible = True
        '    .WindowState = ppWindowMaximized
        Set prs = .Presentations.Open("d:\temp\TestFile.pptx", msoFalse, msoTrue, msoTrue)
        '    Set prs = .ActivePresentation
        Set shp = prs.Slides(1).Shapes("modGrating")
        '    Set shp = prs.Slides(1).Shapes(1)
        shp.Select
        shp.Model3D.IncrementRotationY 50
        '    .Activate
    End With
    Set prs = Nothing
    Set ppt = Nothing
End Sub