' a little powerpoint VB macro for turning the absolute paths used in image links
' into relative paths.

' i wrote it to make it easier to mannage my presentatons using subversion.
' by using all linked images, i keep the main powerpoint
' file small, and thus save bandwidth on repository updates and checkins.
' of course, because linked images default to absolute paths, moving the
' presentation around is awkward.  unless, of course, i remember to run this
' macro, thus converting all my absolute paths to relative ones ;-)
' as a general absolute-to-relative path converter it's not a perfect solution;
' linked images that aren't in the presentation directory or one of it's subdirectories

' will not have their paths made relative.  another minor bug: master
' slides not referenced in the main presentation will not have their paths converted.
' however, this macro is a big improvement over the code in
' http://support.microsoft.com/kb/285317/en-us
' unlike that example, it does treat subdirectories, groups, and active master
' slides correctly.
' -Sven Olsen, Summer 2006

' Perform the substitution for a given shape object.
' The function is recursive -- msoGroup objects
' have ProcessShape called on all of their members

Private Function ProcessShape(oShape, sNum) ' if we have a group object, Process all of it's components If oShape.Type = msoGroup Then For Each pShape In oShape.GroupItems Call ProcessShape(pShape, sNum) Next pShape End If ' i like *all* my pictures to be linked, ' so i put in a warning if i've accidently ' inserted something without linking it. ' ' this is a handy feature if you want to keep ' the file sizes of your .ppt files small ' (say if you storing them using a versioning ' system) ' but a hypothetical "typical user" probably ' won't want it. If oShape.Type = msoPicture Then MsgBox "warning, nonlined picture on slide " & sNum End If ' We've found a linked picture! ' Let's do the substitution. If oShape.Type = msoLinkedPicture Then With oShape.LinkFormat ' This is the path we want to make ourselves relative to. sText = ActivePresentation.Path ' ' The right way to do this text parsing is to first check ' to see if we are in the same drive, and put up a warning if we're not. ' Then we'd find the maximum overlapping part of the paths, ' and calculate a relative path that went through that root. ' ' However, I don't really know my way around VB's text parsing, so ' I've done something much simpler -- I only handle the current and subdirectory ' cases. ' ' First I check to see if the ActivePresentation.Path is inside ' the SourceFullName. If so, I erase it from SourceFullName, ' thus creating a relative path. ' If InStr(.SourceFullName, ActivePresentation.Path) Then lPos = Len(.SourceFullName) - Len(ActivePresentation.Path) - 1 strLink = Right(.SourceFullName, lPos) ' ' Inform the user that we're going to make the switch. ' MsgBox "Substituting '" & strLink & "' for '" & .SourceFullName & "' on slide " & sNum & "." .SourceFullName = strLink End If End With End If End Function
Sub RelPict() Dim oSlide As Slide Dim oShape As Shape Dim lPos As Long Dim strLink As String ' ' Loop through the presentation checking each shape ' on each slide to see if it is a linked picture. ' For Each oSlide In ActivePresentation.Slides ' we'll use this number to make any diagnostic messages ' more informative. sNum = oSlide.SlideNumber For Each oShape In oSlide.Shapes Call ProcessShape(oShape, sNum) Next oShape ' ' also update the master slide. ' note that because most slides have the same master ' the master slide's objects will be analyized many times ' in a single run -- but that's not a problem in practice. ' ' * note that unused master slides won't ever be touched. ' For Each oShape In oSlide.Master.Shapes Call ProcessShape(oShape, sNum) Next oShape Next oSlide End Sub