我想获取PowerPoint中带有超链接的形状。
我将使用 pdf.js 将 powerpoint 显示为 pdf,并且需要在渲染的 pdf 上使用具有正确大小形状的覆盖 html 来附加超链接。
但是如果我尝试使用 LinkFormat.SourceFullName
方法,它会抛出错误
Invalid Request
我已经用明确链接的图像和形状对其进行了测试。另外,不知何故,我链接的形状的类型是 autoShapeTypes。
我使用 Office 356。我主要对演示文稿中幻灯片的链接感兴趣。我可以通过 pptSlide.Hyperlinks(i) 及其子地址访问它们,但是如何获得该链接的引用形状?
有什么想法为什么形状不会显示为链接对象以及我如何能够从形状中获取链接?
Dim pptPresentation As Presentation
Dim pptSlide As Slide
Dim pptShape As Shape
Dim i As Integer
dim linkstring as String
Dim hl As Hyperlink
'Set the variable to the PowerPoint Presentation
Set pptPresentation = ActivePresentation
'Loop through each slide in the presentation
For Each pptSlide In pptPresentation.Slides
'Loop through each shape in each slide
For Each pptShape In pptSlide.Shapes
'Find out if the shape is a linked object or a linked picture
If pptShape.Type = msoLinkedPicture Or pptShape.Type _
= msoLinkedOLEObject Or pptShape.Type = msoLinked3DModel Then
'won't make it into the loop, ad Or 1 for AutoShapeTyps
linkstring = pptShape.LinkFormat.SourceFullName
oFile.WriteLine "link:" & linkstring & vbNewLine & _
"height:" & pptShape.Height & vbNewLine & _
"width:" & pptShape.Width & vbNewLine & _
"pos-left" & pptShape.Left & vbNewLine & _
"pos-top " & pptShape.Top & vbNewLine & _
vbNewLine
End If
Next
Next
'test to see if vba finds any links at all
For Each hl In ActivePresentation.Slides(1).Hyperlinks
linkstring = hl.Address
linkstring = hl.SubAddress
linkstring = hl.Application
linkstring = hl.Type
Next
最佳答案
超链接位置和类型
可以指定超链接
- 形状本身
- 到形状的文本框架
- 单个字符(甚至一个文本中的多个字符)
它们可以指定为 ActionSettings(ppMouseClick).Hyperlink
或 ActionSettings(ppMouseOver).Hyperlink
。
它们的 Hyperlink.Type
是 msoHyperlinkShape
(在形状上)或 msoHyperlinkRange
(在文本框或字符上)。
循环所有超链接并得到对应的Shape
您可以循环遍历幻灯片的所有超链接并在父结构中获取它们的形状,具体取决于超链接类型:
Private Sub GetShapeOfEachHyperLink()
Dim pptSlide As Slide
Dim pptHyperlink As Hyperlink
Dim pptShape As Shape
For Each pptSlide In ActivePresentation.Slides
For Each pptHyperlink In pptSlide.Hyperlinks
Select Case pptHyperlink.Type
Case msoHyperlinkShape
Set pptShape = pptHyperlink.Parent.Parent
Case msoHyperlinkRange
Set pptShape = pptHyperlink.Parent.Parent.Parent.Parent
End Select
Next pptHyperlink
Next pptSlide
End Sub
循环所有形状并获取相应的超链接
反之则有点复杂:
Private Sub GetHyperlinkOfEachShape()
Dim pptSlide As Slide
Dim pptShape As Shape
Dim pptActionSetting As ActionSetting
Dim pptHyperlink As Hyperlink
Dim pptMouseActivation As Variant
Dim strURL As String
Dim i As Integer
For Each pptSlide In ActivePresentation.Slides
For Each pptShape In pptSlide.Shapes
' Hyperlink assigned to shape:
For Each pptActionSetting In pptShape.ActionSettings
If pptActionSetting.Action = ppActionHyperlink Then
Set pptHyperlink = pptActionSetting.Hyperlink
strURL = pptHyperlink.Address: Debug.Print strURL
End If
Next pptActionSetting
' Hyperlinks assigned to text or text parts:
If pptShape.TextFrame.HasText Then
For Each pptMouseActivation In Array(ppMouseClick, ppMouseOver)
Set pptActionSetting = pptShape.TextFrame.TextRange.ActionSettings(pptMouseActivation)
If pptActionSetting.Action = ppActionHyperlink Then
Set pptHyperlink = pptActionSetting.Hyperlink
strURL = pptHyperlink.Address: Debug.Print strURL
Else
strURL = ""
For i = 1 To pptShape.TextFrame.TextRange.Characters.Count
Set pptActionSetting = pptShape.TextFrame.TextRange.Characters(i).ActionSettings(pptMouseActivation)
If pptActionSetting.Action = ppActionHyperlink Then
If strURL <> pptActionSetting.Hyperlink.Address Then
Set pptHyperlink = pptActionSetting.Hyperlink
strURL = pptHyperlink.Address: Debug.Print strURL
End If
End If
Next i
End If
Next pptMouseActivation
End If
Next pptShape
Next pptSlide
End Sub
关于vba - 如何在 PowerPoint VBA 中获取超链接的形状,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/55724877/