在PowerPoint中的每张幻灯片上移动视频答案

【问题标题】：Moving video on every slide in powerpoint在PowerPoint中的每张幻灯片上移动视频
【发布时间】：2017-06-13 13:37:21
【问题描述】：

我只是在 VBA 和 PowerPoint 中闲逛，我知道我想做的事情是可以完成的。我只是不知道要使用的写调用/sytanx！

我想要一个宏，它可以遍历演示文稿中的所有幻灯片并将视频对象移动到幻灯片上的特定位置。所有幻灯片上的位置都相同。

如果有人能告诉我如何做到这一点，那将非常有帮助！或者至少指出我正确的方向。谢谢！

这是我在每张幻灯片上做某事的发现

Sub EveryTextBoxOnSlide()
' Performs some operation on every shape that contains text on every slide
' (doesn't affect charts, tables, etc)

Dim oSh As Shape
Dim oSl As Slide

On Error GoTo ErrorHandler

For Each oSl In ActivePresentation.Slides
    For Each oSh In oSl.Shapes
        With oSh
            If .HasTextFrame Then
                If .TextFrame.HasText Then
                    ' If font size is mixed, don't touch the font size
                    If .TextFrame.TextRange.Font.Size > 0 Then
                        .TextFrame.TextRange.Font.Size = .TextFrame.TextRange.Font.Size + 2
                    End If
                End If
            End If
        End With
    Next    ' shape
Next    ' slide

NormalExit:
Exit Sub

ErrorHandler:
Resume Next

End Sub

这是我发现的将对象移动到所需位置的东西（这里我不知道如何调用视频对象）

With ActiveWindow.Selection.ShapeRange
.Left = 640 'change the number for desired x position
.Top = 75 'change the number for desired y position
End With
End Sub
Sub ll()

End Sub

所以基本上，我想将最后一个片段作为第一个片段的函数而不是带有文本的形状。这有意义吗？

我过去做过一些编程，主要是使用 actionscript 和 Flash。我可能会写出一些基本功能，只是不确定如何在不学习全新语言的情况下在 VBA 中运行它。我不想这样做，因为我是一名教学设计师，没有空闲时间学习它！ :)

【问题讨论】：

在 PowerPoint 中启动宏记录器，然后...哦，MS 把它从 PowerPoint 中删除了，因为他们讨厌我们每个人...：/
说真的，在这里搜索代码以循环浏览您的 PPT 中的幻灯片 - 这是一个简单的循环结构。然后循环遍历幻灯片上的所有形状以识别视频，然后将视频形状的.Top 和.Left 属性设置为所需位置。
我找到了循环播放幻灯片的代码。不过，我很难识别视频。我找到了对象或文本的示例，但不知道如何命名视频！
发布您提出的代码以及您遇到的具体问题。也许留下您尝试过的所有注释代码以及为什么它们不适合您。使用代码和特定问题，您是 on topic 否则，这可能会作为 OT 被关闭，或者只是被忽略......
@FreeMan 我更新了它。希望有意义

标签： vba powerpoint

【解决方案1】：

如果您传递给它的形状是视频，这里有一个小函数将返回 True，以及一些用于测试它的示例代码：

Function IsVideo(oSh As Shape) As Boolean

    If oSh.Type = msoMedia Then
        If oSh.MediaType = ppMediaTypeMovie Then
            IsVideo = True
            Exit Function
        End If
    End If

    ' Things get a little trickier if the movie is in a placeholder
    ' Is it a placeholder? and is it a media object?
    If oSh.Type = msoPlaceholder Then
        If oSh.PlaceholderFormat.ContainedType = msoMedia Then
            ' it's a media object, but we don't know if it's
            ' a movie or sound or what, so we duplicate it
            ' then look at the duplicate (which is now a copy
            ' of the placeholder content but is not a placeholder itself)
            With oSh.Duplicate
                If .Type = msoMedia Then
                    If .MediaType = ppMediaTypeMovie Then
                        IsVideo = True
                    End If
                End If
                ' and delete the duplicate
                .Delete
            End With
        End If
    End If

End Function

Sub thing()

    Dim oSl As Slide
    Dim oSh As Shape

    For Each oSl In ActivePresentation.Slides
        For Each oSh In oSl.Shapes
            If IsVideo(oSh) Then
                oSh.Left = 0
            End If
        Next
    Next
End Sub

【讨论】：

效果很好！该对象是使用 Office Mix 加载项录制的视频。 Mix 会将视频放在幻灯片的右上角，但是对于我正在设计的模板，它需要位于不同的位置（另外，在那个位置看起来有点糟糕！）。我确实懂一点编程，所以我可以跟上。再次感谢！
很高兴它有帮助。
好的，我对其进行了修改以包括将音频对象从幻灯片中移出。但是，Office Mix 中录制的音频被视为电影对象！我使用插入功能录制了音频，并且代码有效。你知道如何区分 Mix 生成的音视频吗？
所以我所做的是创建一个单独的函数，在确定对象为电影后检查对象的大小。如果它低于 50，它将激活布尔 IsAudio，然后添加一个新行，将 IsAudio 真实对象移动到不同的位置。它奏效了！
做得很好。我不使用 Mix，所以没有与它添加到 PPT 的任何磨合。

【解决方案2】：

现在你已经到了某个地方！

我不知道你的视频是什么样的形状，所以这个修改应该可以帮助你识别它。

Sub EveryTextBoxOnSlide()

Dim oSh As Shape
Dim oSl As Slide

On Error GoTo ErrorHandler

For Each oSl In ActivePresentation.Slides
    For Each oSh In oSl.Shapes
        With oSh
          .Select
        End With
    Next
Next

NormalExit:
  Exit Sub

ErrorHandler:
  Resume Next

End Sub

虽然没有必要在最终代码中使用.Select，但这只是为了帮助您识别哪个形状实际保存了视频。在该行放置一个断点 (F9) 并运行您的代码 (F5)，然后使用 F8 对其进行调试以执行一行时间并循环查看每个形状，直到您看到您的视频已被选中。

一旦您的视频被选中，请查看oSh 的各种属性（使用IDE 的Immediate Window），直到找到标识这是您的视频的唯一性。（可能有一些关于形状的内容类型的属性，或者在哪里可以找到包含文本字符串“.avi”、“.mpg”、“.flv”等的内容的链接 - 会有一些你可以找到的标识符。）

一旦你确定了是什么让形状成为视频的持有者，替换

.Select

与

If {my video containing shape criteria is true} Then 
  With .Selection.ShapeRange
    .Left = 640 'change the number for desired x position
    .Top = 75 'change the number for desired y position
  End With
End If

将值（如注释）更改为您需要的任何值。

重要提示：您的示例代码内置了一些错误处理，这非常好，但是这个错误处理程序所做的只是清除所有错误。这个特殊的处理程序是 On Error Resume Next 的超长格式版本，它确实有它的用途，但在非常非常有限的情况下。

当您的代码正常工作时，您实际上会想在ErrorHandler: 部分中添加一些有用的东西，但这是一个全新问题的主题。

【讨论】：

好的，我们到了！我选择了视频，但不确定如何检查属性。我在编辑器中打开了即时窗口，但不确定这是否是您的意思！
在即时窗口中，键入?oSh.，IntelliSense 将弹出所有可用属性和方法的列表。滚动浏览属性，寻找可以帮助您识别它是哪种形状的东西。不幸的是，我无法帮助你，因为自从我在 PPT 中嵌入视频以来，它已经永远存在了，而且我当时当然没有用 VBA 修改它。当你找到一个看起来很可能的候选人时，选择它并点击Enter，你会得到该属性的值打印出来。
好的，谢谢。我现在有点头疼，所以我明天再解决这个问题！

【解决方案3】：

好的，这是我如何修改上面提供的代码以在我的情况下执行此操作：

 Sub EveryTextBoxOnSlide() ' Performs some operation on every shape that contains text on every slide ' (doesn't affect charts, tables, etc) Dim oSh As Shape Dim oSl As Slide On Error GoTo ErrorHandler

For Each oSl In ActivePresentation.Slides
    For Each oSh In oSl.Shapes
        With oSh
           If .Type = msoMedia Then
                 If .MediaType = ppMediaTypeMovie Then
                    .PictureFormat.Crop.PictureHeight = 236
                    .PictureFormat.Crop.PictureWidth = 314.2115
                    .PictureFormat.Crop.PictureOffsetX = 8.737323
                    .PictureFormat.Crop.PictureOffsetY = 0
                    .PictureFormat.Crop.ShapeHeight = 236.3478
                    .PictureFormat.Crop.ShapeWidth = 163
                    .PictureFormat.Crop.ShapeLeft = 796.6956
                    .PictureFormat.Crop.ShapeTop = 0
                 End If
           End If
        End With
    Next    ' shape Next    ' slide

NormalExit: Exit Sub

ErrorHandler: Resume Next

End Sub

【讨论】：