如何在下拉列表中包含 PowerPoint 中的链接列表

How to have the list of links from PowerPoint in a dropdown list

我需要在表单的下拉列表中列出 PowerPoint 中的所有 link。

要找到 links 我已经有了以下代码:

Sub listing()
    Dim oSld As Slide
    Dim oSh As Shape
        For Each oSld In ActivePresentation.Slides
        For Each oSh In oSld.Shapes
    
       If oSh.Type = msoLinkedPicture Or oSh.Type = msoLinkedOLEObject Then
           Path = oSh.LinkFormat.SourceFullName
           Position = InStr(1, Path, "!", vbTextCompare)
           FileName = Left(Path, Position - 1)
           
           MsgBox FileName ' This will lists each link one by one
       End If
   Next oSh
Next oSld
End Sub

上面的代码也会产生重复项,因为多个对象具有相同的 link 但 Excel 中的范围不同。例如,我需要的列表应该只包含唯一值

要填写表格中的下拉列表,我有以下代码:

Private Sub UserForm_Initialize()

    If ComboBox2.ListCount = 0 Then
        AddDropDownItems
    End If
End Sub

Sub AddDropDownItems()
    ComboBox2.AddItem "1"
    ComboBox2.AddItem "2"
    ComboBox2.AddItem "3"
End Sub

我想不通的是如何合并这两个代码,以便在下拉列表中列出 link。

试试这个代码:

UserForm1 模块中

Private Sub UserForm_Initialize()
    Dim oSld As Slide, oSh As Shape
    
    Dim list As New Collection  'declare and make new Collection
    
    For Each oSld In ActivePresentation.Slides
        For Each oSh In oSld.Shapes
            If oSh.Type = msoLinkedPicture Or oSh.Type = msoLinkedOLEObject Then
                Path = oSh.LinkFormat.SourceFullName
                Position = InStr(1, Path, "!", vbTextCompare)
                If Position > 0 Then Path = Left(Path, Position - 1)
                
                ' adding paths to the collection to avoid
                ' duplication (duplicate keys are not allowed)
                ' also you can use Dictionary object with .Exist() method
                On Error Resume Next
                list.Add Path, Path ' add Path as an item and as a key
                On Error GoTo 0
            End If
        Next oSh
    Next oSld
    
    With Me.ComboBox2
        .Clear
        For Each el In list
            .AddItem el 'add Paths from Collection
        Next
    End With
End Sub

标准模块

Sub test()
    UserForm1.Show
End Sub