如何在下拉列表中包含 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
我需要在表单的下拉列表中列出 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