vba hyperlinks and shape creation

Question

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.

Solution

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

Comments

[uncertaintea]

beautiful. Thank you. the only problem i am having is that it says SlideNumber is not a defined variable.

[brettdj]

@uncertaintea I left that in from your prior code - I suggest deleting it as ths SubAddress propery sets the Place in ThisDocument which is what you want. Address looks like it sets Existing File or Web Page

[Iban Arriola]

@brettdj I have a question in this matter... if now I put a new slide before slide 2 subAddress won't change. How can I make it to update add reference the correct slide? Thanks