Insert bulk hyperlink from Excel list to PowerPoint

[huss3in999]

Hi I have PowerPoint has 83 slides each slide have 12 images and 12 textboxes (textbox names for each slide start from 1 to 12)

What I'm trying to do I have excel sheet which has all my data

Column A has a slide number For the PowerPoint

Column B has textbox name

Column c has a title which will be transferred to a textbox

Macro code I have will find slide number and textbox or shape name and will insert title from column c

I'm missing with one code I want to insert hyperlink for each name of textbox or on title

Column E I have my hyperlink list which I need to insert for each textbox in PowerPoint

Dim ppapp As PowerPoint.Application
Dim pppres As PowerPoint.Presentation

Sub getshapedata()
Set ppapp = GetObject(, "Powerpoint.application")
Set ppres = ppapp.ActivePresentation

On Error GoTo line1

Dim shapeslide
Dim shapename
Dim shapetext
Dim nextrow

shapeslide = ppapp.ActiveWindow.View.Slide.SlideIndex
shapename = ppapp.ActiveWindow.Selection.ShapeRange(1).Name
shapetext = ppres.Slides(shapeslide).Shapes(shapename).TextEffect.Text
friendlyname = InputBox("Insert Friendly Name for " & shapetext, "FriendlyName", "")

nextrow = Sheet2.Range("a" & Rows.Count).End(xlUp).Row + 1

Sheet2.Range("a" & nextrow) = shapeslide
Sheet2.Range("b" & nextrow) = shapename
Sheet2.Range("c" & nextrow) = shapetext
Sheet2.Range("d" & nextrow) = friendlyname

Exit Sub

line1:
MsgBox ("No item selected")

End Sub


Sub writedata()
Dim c As Object
Dim shapeslide
Dim shapename
Dim shapetext


Set ppapp = GetObject(, "Powerpoint.application")
Set ppres = ppapp.ActivePresentation


For Each c In Sheet2.Range("a2:a" & Sheet2.Range("a" & Rows.Count).End(xlUp).Row)

    shapeslide = Sheet2.Range("a" & c.Row)
    shapename = Sheet2.Range("b" & c.Row)
    shapetext = Sheet2.Range("c" & c.Row).Text
    friendlyname = Sheet2.Range("d" & c.Row)
    ppres.Slides(shapeslide).Shapes(shapename).TextEffect.Text = shapetext

Next c


End Sub