VBA Tools

Często zdarza się że przygotowana wcześniej prezentacja musi zostać przeniesiona w inne miejsce i z niego zaprezentowana. Od tego miejsca zależy czy podpięte pliki animacji (filmy) w naszej prezentacji będą działać prawidłowo (odtwarzać materiał).

Podpinanie ich ponownie jest czasochłonne, ponieważ należy ponownie osadzić obiekt oraz dobrać parametry slajdu.

Można jednak temu zaradzić wpisując nową ścieżkę do plików w komunikat poniższej procedury:

Sub Change_URL_To_Movies()
'MVP OShon from VBATools.pl
Dim oSl As Slide, oHl As Shape, File$, ile&, New_path$
New_path = InputBox("Wpisz scieżkę do plików:", _
 "Wstawianie nowej scieżki", ActivePresentation.Path)
If FileExists(New_path) = False Or Len(New_path) = 0 Then _
 MsgBox "Podana ścieżka nie istnieje!", vbExclamation, "VBATools.pl": Exit Sub
If Left(New_path, 1) <> "\" Then New_path = New_path & "\"
On Error GoTo blad
 For Each oSl In ActivePresentation.Slides
 For Each oHl In oSl.Shapes
 If oHl.Type = 16 Then
 With oHl.LinkFormat
 File = Dir(.SourceFullName)
 .SourceFullName = New_path & File
 ile = ile + 1
 End With
 End If
 Next
 Next
 If ile > 0 Then
 MsgBox "podmieniono ścieżki." & vbCr & "Można sprawdzic prezentacje.", _
 vbInformation, "VBATools.pl"
 Else
 MsgBox "Nie znaleziono żadnych plików z animacją.", _
 vbExclamation, "VBATools.pl"
 End If
Exit Sub
blad:
 MsgBox "Błąd: " & Err.Number & vbCr & Err.Description, _
 vbCritical, "VBATools.pl"
End Sub

Private Function FileExists(FilePath As String) As Boolean
On Error GoTo blad
 FileExists = Len(Dir(FilePath, vbDirectory Or vbHidden Or vbSystem)) > 0
Exit Function
blad:
FileExists = False
End Function

Procedurę tą osadzamy w developerze VBA PowerPointa [Alt+F11] Menu/Insert/Module, którą następnie możemy odpalić przy pomocy klawisza [F5].

(c) Shon Oskar – www.VBATools.pl

Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.