VBA 超链接和形状创建

发布于 2024-12-24 00:27:17 字数 700 浏览 3 评论 0原文

我有一个将创建形状的子例程，但代码有两个问题：

我必须指定将在哪张幻灯片上创建此形状。如果我想同时在多张幻灯片上创建相同的形状，这就是一个问题。我该如何实现这一目标？我该如何替换 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 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.

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.

分享到QQ

分享到微博

如果你对这篇内容有疑问，欢迎到本站社区发帖提问参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

发布评论

需要登录才能够评论，你可以免费注册一个本站的账号。

唔猫 2024-12-31 00:27:17

类似的操作将作用于当前幻灯片。我测试了幻灯片 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

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)

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

回复收藏 0 原文

~没有更多了~