用vba脚本获得ppt内嵌视频地址(thinkvd开发日志)

最新推荐文章于 2023-02-17 05:58:48 发布

原创最新推荐文章于 2023-02-17 05:58:48 发布 · 1.7k 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#vba #脚本 #string #types #file #user

Shell 专栏收录该内容

1 篇文章

订阅专栏

本文提供了一个VBA脚本，用于编辑PPT中形状的链接，特别是内嵌视频的链接。用户需先选择一个包含视频的形状，然后脚本会获取并允许编辑其链接地址。如果链接有效，脚本将更新链接；否则，将显示错误消息。C++程序实现类似功能时需考虑shape的类型。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

载自：http://www.pptfaq.com/FAQ00433.htm

Sub EditLink()
' Edit links of some types
' Little error checking.  It works or not.  No harm if not.

    Dim sLinkSource As String
    Dim sOriginalLinkSource As String

    If ActiveWindow.Selection.ShapeRange.Count <> 1 Then
      MsgBox ("Please select one and only one shape, then try again.")
      Exit Sub
    End If

    With ActiveWindow.Selection.ShapeRange(1)
        'MsgBox .LinkFormat.SourceFullName
        sOriginalLinkSource = .LinkFormat.SourceFullName
        sLinkSource = InputBox("Edit the link", "Link Editor", sOriginalLinkSource)

        If sLinkSource = sOriginalLinkSource Then
            ' nothing changed; our work on this planet is done
            Exit Sub
        End If
        If sLinkSource = "" Then
            ' The user canceled; quit:
            Exit Sub
        End If

        ' Get the filename portion of the link in case it's a link to a range
        Debug.Print Mid$(sLinkSource, 1, InStr(sLinkSource, ".") + 3)

        ' Is it a valid filename?  Is the file where it belongs?
        ' Test against the filename portion of the link in case the link includes
        ' range information
        If Dir$(Mid$(sLinkSource, 1, InStr(sLinkSource, ".") + 3)) <> "" Then
            .LinkFormat.SourceFullName = sLinkSource
            .LinkFormat.Update
        Else
            MsgBox "Can't find " & sLinkSource
        End If

    End With

End Sub

链接网页里面有使用说明，在此不多说了。
注意：一定要选择一个带视频的且激活的shape, 否则vba脚本得不到.LinkFormat.SourceFullName
同功能的C++程序略与它有点差异，需要判断shape.type类型即可.