VBA to add multiple hyperlinks to one Powerpoint text box

Question

I'm using a VBA loop in Powerpoint to import data from Excel and write each new string that has been imported as a new bullet in the text box on the slide. This works fine. Then a hyperlink that is also imported should be added to each bullet. This works except that only the last bullet keeps its hyperlink. I suspect that the hyperlink is added not specifically to the bullet but to the text box and therefore is overwritten with each new bullet leaving only the bottom bullet with a hyperlink. Any idea how I can get all bullets' hyperlinks to remain?

Many thanks!

new_slide.Shapes(2).TextFrame.TextRange.text = new_slide.Shapes(2).TextFrame.TextRange.text & vbNewLine & new_text

With new_slide.Shapes(2).TextFrame.TextRange.Find(new_text).ActionSettings(ppMouseClick)
    .Action = ppActionHyperlink
    .Hyperlink.Address = excel_link
End With

Answer 1

{modified version}

It works if we add the text first, then step through each line, adding the hyperlink a line at a time. You'll need to either step through your XL import twice, once for the text, once for the hyperlinks:

Sub RoundTwo()
    Dim oSh As Shape
    Dim x As Long
    
    Set oSh = ActiveWindow.Selection.ShapeRange(1)
    
    For x = 1 To 3
        With oSh.TextFrame.TextRange
            .Text = .Text & vbNewLine & "Some new text"
        End With
    Next
    
    For x = 1 To 3
        Call AddLinkToLine(oSh, x)
    Next
    
End Sub

Sub AddLinkToLine(oSh As Shape, lLine As Long)
    With oSh.TextFrame.TextRange.Paragraphs(lLine)
        With .ActionSettings(ppMouseClick)
            .Action = ppActionHyperlink
            .Hyperlink.Address = "http://www.pptfaq.com"
        End With
    End With
End Sub