vba 超链接和形状创建
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/8705136/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
vba hyperlinks and shape creation
提问by uncertaintea
I have a subroutine that will create a shape, but I have two problems with the code:
我有一个可以创建形状的子程序，但是我的代码有两个问题：
- I must specify on which slide this shape will be created. This is a problem if I want to create the same shape on multiple slides simultaneously. How do I achieve that? what do I replace activepresentation.slides(x) with?
- I want the shape to have a hyperlink to a specific slide. What is wrong with my code to achieve that? It gives me an error when I try to assign an action to the shape I have created.
- 我必须指定将在哪个幻灯片上创建此形状。如果我想同时在多张幻灯片上创建相同的形状，这是一个问题。我如何做到这一点？我用什么替换 activepresentation.slides(x) ？
- 我希望形状具有指向特定幻灯片的超链接。我的代码有什么问题来实现这一目标？当我尝试为我创建的形状分配一个动作时，它给了我一个错误。
Sub createshape()
Dim oshp As Shape
Dim osld As Slide
'old code
Set osld = ActivePresentation.Slides(1)
Set oshp = osld.Shapes.AddShape(msoShapeRectangle, 485, 15, 104, 60)
oshp.ActionSettings (ppMouseClick)
.Action = ppActionHyperlink
.Hyperlink.Address = SlideNumber
.Hyperlink.SubAddress = 1 'this should take the hyperlink to slide 1 i hope.
End Sub
I want to automate this function because I will be doing this same thing for many many slides multiple times.
我想自动化这个功能，因为我将多次为许多幻灯片做同样的事情。
回答by brettdj
Something like this will act on the current slide. I tested for a slide 2 hyperlink to esnure that the code worked (and didn't use 1 as default)
像这样的东西将作用于当前幻灯片。我测试了幻灯片 2 的超链接以确保代码有效（并且没有使用 1 作为默认值）
Sub CreateShape()
Dim oShp As Shape
Dim oSld As Slide
Set oSld = ActivePresentation.Slides(ActiveWindow.Selection.SlideRange.SlideIndex)
Set oShp = oSld.Shapes.AddShape(msoShapeRectangle, 485, 15, 104, 60)
With oShp.ActionSettings(ppMouseClick)
.Action = ppActionHyperlink
'.Hyperlink.Address = SlideNumber
.Hyperlink.SubAddress = 2
End With
End Sub
