Supercharge your PowerPoint productivity with
Supercharge your PPT Productivity with PPTools - Click here to learn more.

PPTools

Image Export converts PowerPoint slides to high-quality images.

PPT2HTML exports HTML even from PowerPoint 2010 and 2013, gives you full control of PowerPoint HTML output, helps meet Section 508 accessibility requirements

Merge Excel data into PowerPoint presentations to create certificates, awards presentations, personalized presentations and more

Resize your presentations quickly and without distortion

Language Selector switches the text in your presentation from one language to another

FixLinks prevents broken links when you distribute PowerPoint presentations

Shape Styles brings styles to PowerPoint. Apply complex formatting with a single click.

Prep4PDF preserves interactivity in PowerPoint presentations when you convert to PDF

Convert slide titles to shapes to solve hyperlink limit problems

Problem

As described elsewhere in this FAQ, PowerPoint has a fixed limit upper limit on the amount of link information it can store. Once you exceed those limits, your links start acting crazy. They're liable to disappear or point to the wrong places.

One contributing factor can be the length of your slide titles; these become part of the information PowerPoint stores in its hyperlinks collection. The shorter your titles, the more links you can store.

Solution

This routine makes copies of all your slide titles (so they appear not to change at all) but replaces the actual title with much shorter text ( S-xx, where xx is the slide number). It then replaces all of the previous title text in your slide links with the new short version.

NEVER run this on your original presentation. ALWAYS run it on a copy of your work.

Sub TitlesToText()
' Converts titles to text shapes then changes titles to something short
' in order to help solve hyperlink problems due to over-long/too-many titles

    Dim oSlide As Slide
    Dim oSlides As Slides
    Dim oShapes As Shapes
    Dim oSh As Shape
    Dim oHyperlinks As Hyperlinks
    Dim oHl As Hyperlink
    Dim tmpText1 As String
    Dim tmpText2 As String

    Set oSlides = ActivePresentation.Slides

    For Each oSlide In oSlides
        ' Deal with the titles:
        Set oShapes = oSlide.Shapes
        For Each oSh In oShapes
            If oSh.Type = msoPlaceholder Then
                If oSh.HasTextFrame Then
                    If oSh.TextFrame.HasText Then
                        If oSh.PlaceholderFormat.Type = ppPlaceholderCenterTitle Or _
                            oSh.PlaceholderFormat.Type = ppPlaceholderTitle Then
                            ' make a copy of the title and move it to match title's position
                            With oSh.Duplicate
                                .Top = oSh.Top
                                .Left = oSh.Left
                                .Tags.Add "OriginalTitleText", oSh.TextFrame.TextRange.Text
                            End With

                            ' change the title text to something innocuous (and SHORT)
                            ' or leave it as is, but remove the commas
                            ' remove the ' from one or the other of the following lines 
                            ' to choose which:
                            'oSh.TextFrame.TextRange.Text = "S-" & CStr(oSlide.SlideIndex)
                            oSh.TextFrame.TextRange.Text = _
                                Replace(oSh.TextFrame.TextRange.Text, ",", " ")

                            ' and hide it
                            oSh.Visible = msoFalse
                        End If
                    End If
                End If
            End If
        Next oSh

        ' fix up hyperlinks
        Set oHyperlinks = oSlide.Hyperlinks
        For Each oHl In oHyperlinks
            If oHl.Address = "" And oHl.SubAddress <> "" Then
                If InStr(oHl.SubAddress, ",") > 0 Then
                    tmpText1 = oHl.SubAddress    ' xx,yy,This is the old title
                    ' get the text up to and including the first comma
                    tmpText2 = Mid$(tmpText1, 1, InStr(tmpText1, ",")) ' xx,
                    ' strip off the text we just grabbed
                    tmpText1 = Right$(tmpText1, Len(tmpText1) - Len(tmpText2)) ' yy,This is the old title
                    ' Get the text up to and including the first comma, append it
                    tmpText2 = tmpText2 & Mid$(tmpText1, 1, InStr(tmpText1, ","))
                    ' append a null
                    tmpText2 = tmpText2 & " "
                    oHl.SubAddress = tmpText2
                End If
            End If
        Next oHl

    Next oSlide

    Set oSlide = Nothing
    Set oSlides = Nothing

End Sub

To get a report of the slides in the presentation plus the original titles (as opposed to the new short ones), you can use this:

Sub GatherTitles()
' This is a modified version of the GatherTitles macro
' that collects the original title text stored in tags
' by our TitlesToText macro

    Dim oSlide As Slide
    Dim strTitles As String
    Dim strFilename As String
    Dim intFileNum As Integer
    Dim PathSep As String

    If ActivePresentation.Path = "" Then
        MsgBox "Please save the presentation then try again"
        Exit Sub
    End If

    #If Mac Then
        PathSep = ":"
    #Else
        PathSep = "\"
    #End If

    For Each oSlide In ActiveWindow.Presentation.Slides
        On Error Resume Next    ' in case the title shape's gone missing
        strTitles = strTitles _
            & "Slide: " _
            & CStr(oSlide.SlideIndex) & vbCrLf _
            & oSlide.Shapes("PseudoTitle").Tags("OriginalTitleText") _
            & vbCrLf & vbCrLf
    Next oSlide

    intFileNum = FreeFile

    ' PC-Centricity Alert!
    ' This assumes that the file has a .PPT extension and strips it off to make the text file name.
    strFilename = ActivePresentation.Path _
        & PathSep _
        & Mid$(ActivePresentation.Name, 1, Len(ActivePresentation.Name) - 4) _
        & "_Titles.TXT"

    Open strFilename For Output As intFileNum
    Print #intFileNum, strTitles
    Close intFileNum
    Call Shell("Notepad " & strFilename, vbNormalFocus)
End Sub

See How do I use VBA code in PowerPoint? to learn how to use this example code.


Did this solve your problem? If so, please consider supporting the PPT FAQ with a small PayPal donation.
Page copy protected against web site content infringement by Copyscape Contents © 1995 - 2015 Stephen Rindsberg, Rindsberg Photography, Inc. and members of the MS PowerPoint MVP team. You may link to this page but any form of unauthorized reproduction of this page's contents is expressly forbidden.
Español    Deutsch    Français    Português    Italiano    Nederlands    Greek    Japanese    Korean    Chinese

Supercharge your PPT Productivity with PPTools

content authoring & site maintenance by
Friday, the automatic faq maker (logo)
Friday - The Automatic FAQ Maker

Convert slide titles to shapes to solve hyperlink limit problems
http://www.pptfaq.com/FAQ00683_Convert_slide_titles_to_shapes_to_solve_hyperlink_limit_problems.htm
Last update 07 June, 2011
Created: