Question

我只是在用VBA浏览VBA并知道我想做的事情可以完成。我只是不知道使用写调用/ 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中运行它。我不想这样做，因为我是一名教学设计师，没有空闲时间学习它！：）

Answer 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

Answer 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 进行调试，以执行一行时间并通过循环查看每个形状，直到您看到您的视频已被选中。

选择视频后，请查看Immediate Window的各种属性（使用IDE的oSh），直到找到标识此视频的唯一性。（关于形状的内容类型可能有一些属性，或者在哪里找到包含文本字符串“.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:部分中添加一些有用的内容，但这是一个全新问题的主题。

Answer 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

在powerpoint中的每张幻灯片上移动视频

3 个答案: