如何识别PPT中的Slide Zoom对象、设置Return to Zoom属性及获取跳转目标？

1. 识别Slide Zoom对应的Shape对象 #

Slide Zoom本质是带有特定超链接配置的形状，可通过以下VBA代码遍历幻灯片中的形状，筛选出Slide Zoom对象：

Sub FindSlideZooms()
    Dim sld As Slide
    Dim shp As Shape
    
    For Each sld In ActivePresentation.Slides
        For Each shp In sld.Shapes
            ' 针对Office 365/PPT 2019及以上版本，直接用ZoomFormat判断
            If shp.Type = msoLinkedPicture Then
                On Error Resume Next
                Dim zoomType As PpZoomType
                zoomType = shp.ZoomFormat.Type
                If Err.Number = 0 And zoomType = ppZoomSlide Then
                    Debug.Print "找到Slide Zoom：幻灯片" & sld.SlideIndex & "中的形状" & shp.Name
                End If
                On Error GoTo 0
                
                ' 兼容PPT 2016的方式：检查超链接子地址是否包含slideZoom标识
                If shp.Hyperlink.SubAddress Like "*slideZoom,*" Then
                    Debug.Print "找到Slide Zoom（兼容PPT2016）：幻灯片" & sld.SlideIndex & "中的形状" & shp.Name
                End If
            End If
        Next shp
    Next sld
End Sub

说明：PPT 2016中没有ZoomFormat属性，因此需要通过超链接子地址的特征来判断；而Office 365/PPT 2019及以上版本可直接通过ZoomFormat.Type = ppZoomSlide精准识别。你提到的HasSectionZoom属性是针对Section Zoom对象的，Slide Zoom并不适用。

2. 设置“Return to Zoom”属性 #

Office 365/PPT 2019及以上版本 #

直接通过ZoomFormat.ReturnToZoom属性设置：

Sub SetReturnToZoom()
    Dim sld As Slide
    Dim shp As Shape
    
    For Each sld In ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.Type = msoLinkedPicture Then
                On Error Resume Next
                If shp.ZoomFormat.Type = ppZoomSlide Then
                    shp.ZoomFormat.ReturnToZoom = True ' 开启Return to Zoom
                End If
                On Error GoTo 0
            End If
        Next shp
    Next sld
End Sub

PPT 2016兼容方案 #

PPT 2016中没有直接的ReturnToZoom属性，需要通过修改超链接的参数实现：

Sub SetReturnToZoom_2016()
    Dim sld As Slide
    Dim shp As Shape
    Dim subAddrParts As Variant
    
    For Each sld In ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.Type = msoLinkedPicture And shp.Hyperlink.SubAddress Like "*slideZoom,*" Then
                subAddrParts = Split(shp.Hyperlink.SubAddress, ",")
                ' 重新构造子地址，添加ReturnToZoom参数
                If UBound(subAddrParts) >= 1 Then
                    shp.Hyperlink.SubAddress = "slideZoom," & subAddrParts(1) & ",1"
                End If
            End If
        Next shp
    Next sld
End Sub

说明：PPT2016中Slide Zoom的超链接子地址格式为slideZoom,幻灯片ID，添加,1后缀即可开启“Return to Zoom”。

3. 获取Slide Zoom跳转的目标幻灯片信息 #

Office 365/PPT 2019及以上版本 #

直接通过ZoomFormat.TargetSlide或TargetSlideIndex获取：

Sub GetZoomTarget()
    Dim sld As Slide
    Dim shp As Shape
    Dim targetSld As Slide
    
    For Each sld In ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.Type = msoLinkedPicture Then
                On Error Resume Next
                If shp.ZoomFormat.Type = ppZoomSlide Then
                    Set targetSld = shp.ZoomFormat.TargetSlide
                    Debug.Print "Slide Zoom目标：幻灯片" & targetSld.SlideIndex & "，标题：" & targetSld.Shapes.Title.TextFrame.TextRange.Text
                End If
                On Error GoTo 0
            End If
        Next shp
    Next sld
End Sub

PPT 2016兼容方案 #

解析超链接子地址中的幻灯片ID，再匹配对应幻灯片：

Sub GetZoomTarget_2016()
    Dim sld As Slide
    Dim shp As Shape
    Dim subAddrParts As Variant
    Dim targetSlideID As Long
    Dim targetSld As Slide
    
    For Each sld In ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.Type = msoLinkedPicture And shp.Hyperlink.SubAddress Like "*slideZoom,*" Then
                subAddrParts = Split(shp.Hyperlink.SubAddress, ",")
                targetSlideID = CLng(subAddrParts(1))
                ' 通过幻灯片ID查找目标幻灯片
                For Each targetSld In ActivePresentation.Slides
                    If targetSld.SlideID = targetSlideID Then
                        Debug.Print "Slide Zoom目标：幻灯片" & targetSld.SlideIndex & "，标题：" & targetSld.Shapes.Title.TextFrame.TextRange.Text
                        Exit For
                    End If
                Next targetSld
            End If
        Next shp
    Next sld
End Sub

内容的提问来源于stack exchange，提问作者Roger Heckly