Insert bulk hyperlink from Excel list to PowerPoint

huss3in999

New Member
Joined
Jun 27, 2020
Messages
1
Office Version
  1. 2019
  2. 2016
  3. 2013
  4. 2011
  5. 2010
Platform
  1. Windows
  2. Web
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

VBA Code:
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

Untitled.png
 

Attachments

  • vba.png
    vba.png
    45.8 KB · Views: 28

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

Forum statistics

Threads
1,223,886
Messages
6,175,191
Members
452,616
Latest member
intern444

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top