HotDog's Blog

Hotdog (Robert Verpalen) about C# and vb.net

This blog hosted by:
http://blogs.vbcity.com      
  Home :: Syndication  :: Login

AprMay 2008Jun
SMTWTFS
27282930123
45678910
11121314151617
18192021222324
25262728293031
1234567

Articles

Archives

Topics

CONTACT

Fun but useful linkies

General

VS 2005

Wolfenstein ET

For starters, I should mention I'm not what you'd call an experienced PowerPoint user. But like most, I use it now and then. The things you can do with it are great too, but I just couldn't find an easy way to relink url's of movie objects. Relative didn't seem to be possible unless the movies were in the same folder as the presentation itself.

Googling seems to indicate that PP always links to absolute paths, with no option to turn to relative and besides that: couldn't even find a way to change the url in PP itself. The only way seemed to be to add a new object when the presentation was moved. Not the thing that was wanted :(

Luckily VBA can do a lot more than the default stuff and so, for anyone interested, the following code was created. It relinks all movie objects (a lot easier than doing it one by one manually anyway)
Off course, if I missed some easy option inside PP, do tell. :) (as I may have mentioned somewhere in this overly long intro, I haven't used PP that much :p )

Install
For those not familiar with VBA, but do want to use this functionality:
-open the VBA editor (Tools->Macro->Visual basic editor)
-Add a new module (Insert->Module)
-Paste the code below inside that module
After this, you can simply run the macro's from within PP itself. Simply go to Tools->Macro->Macros and you can choose either RelinkMoviesToDefaultLocation or RelinkMoviesAndAskForLocation to run (The difference is explained below)

----------------------------------------------------

Option Explicit

Public Const DefaultMovieSubFolder  As String = "Movies"

'relinks all movies to the default subdirectory beneath the presentations location
'the name of the subdirectory is set in the DefaultMovieSubFolder constant
Public Sub RelinkMoviesToDefaultLocation()
    Dim folder As String
    folder = GetDir(ActivePresentation.FullName) & DefaultMovieSubFolder
    RelinkMovies folder
End Sub

'Ask the user for a directory and relinks all movie objects to that location
Public Sub RelinkMoviesAndAskForLocation()
    Dim folder As String
    folder = InputBox("Please enter target directory", , GetDir(ActivePresentation.FullName))
    If Len(folder) = 0 Then Exit Sub
    RelinkMovies folder
End Sub

Public Sub RelinkMovies(Target As String)
    If Len(Dir(Target, vbDirectory)) = 0 Then
        MsgBox "The target directory (" + Target + ") does not exist. Relinking cancelled"
        Exit Sub
    End If
   
    Dim sl As Slide, sh As Shape, count As Integer, relinked As Integer
    If Not Right$(Target, 1) = "\" Then Target = Target & "\"
    For Each sl In ActivePresentation.Slides
        For Each sh In sl.Shapes
            If IsMovie(sh) Then
                If Relink(sh, Target) Then relinked = relinked + 1
                count = count + 1
            End If
        Next
    Next
    MsgBox "Finished: " & count & " movie objects were checked and " & relinked & " were relinked"
End Sub

Private Function IsMovie(sh As Shape)
    On Error Resume Next
    IsMovie = sh.MediaType = ppMediaTypeMovie
End Function

Function Relink(sh As Shape, TargetDir As String) As Boolean
    Dim File As String, Current As String
    File = sh.LinkFormat.SourceFullName
    Current = GetDir(File)
   
    If Current = TargetDir Then
        Exit Function 'no change made
    End If
   
    File = TargetDir & Mid$(File, Len(Current) + 1)
    sh.LinkFormat.SourceFullName = File
    Relink = True
End Function


Private Function GetDir(File As String) As String
    Dim i As Integer
    i = InStrRev(File, "\")
    If i = 0 Then
        GetDir = ""
    Else
        GetDir = Left$(File, i)
    End If
End Function

 

posted on Friday, July 28, 2006 3:01 AM