Execution d'un VBS avec chemins relatifs dans PowerPoint

Version imprimable

29/04/2014, 13h06
Rick Dangerous

Execution d'un VBS avec chemins relatifs dans PowerPoint
Bonjour,

J'ai un problème un peu pointu qui concerne l'exécution d'un .vbs dans PowerPoint. Voici ce que j'aimerais faire :

Je dois insérer des vidéos sous-titrées dans une présentation, mais les sous-titres ne sont pas correctement gérés par PowerPoint. Je passe donc par l'application Media Player Classic, qui gère parfaitement la lecture de sous-titres sans nécessiter d'installation sur le système. Dans mon PPT, je ne vais donc pas insérer directement les vidéos, mais des liens indiquant qu'il faut lancer Media Player Classic, en lisant la vidéo spécifiée, avec des arguments (mettre en plein écran, lire le fichier de sous-titres, fermer à la fin).
J'ai donc fait des tests en créant un .vbs, qui ouvre Media Player, et la vidéo spécifiée, le tout à partir de chemins relatifs (mon PowerPoint est destiné à un certain nombre d'utilisateurs, je ne sais pas dans quel dossier ils le mettront, donc je dois m'en tenir à des chemins d'accès relatifs).

Le .vbs est tout simple :
Code:

1 2 3 Set WS = CreateObject("Wscript.Shell") CM = "cmd.exe /c" & ".\MPC\MediaPlayerClassic.exe "".\Videos\ma vidéo.wmv"" /fullscreen /close" WS.RUN CM,0,True
Mon script fonctionne très bien... sauf que, dans PowerPoint, quand je l'insère comme un fichier .exe, ça marche la première fois. Mais quand j'enregistre le document, et que je le rouvre ensuite, au moment d'exécuter mon script, il me dit que le fichier est introuvable.
J'ai fini par comprendre qu'en fait, il l'exécutait non pas de son emplacement initial, mais du dossier "Mes Documents" (qui est le dossier par défaut dans PowerPoint). Donc forcément, mes chemins relatifs ne sont plus valables, et il ne trouve plus ni Media Player, ni mes vidéos.

Est-ce que quelqu'un sait d'où peut venir ce problème ?
Merci par avance pour votre aide !! :)

:salut:
Inspirez-vous de ce code qui ouvre une vidéo en plein écran avec le programme VLC.exe

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
Option Explicit
Dim MyApplication,Param,MyVideo
MyApplication = "%Programfiles%\VideoLAN\VLC\VLC.exe" 'Chemin du programme
Param = " --fullscreen" 'Paramètre plein écran
MyVideo = "C:\Users\Mehdi\Documents\Camtasia Studio\MatrixLogin\MatrixLogin.mp4" 'Chemin de la vidéo à ouvrir
Call Jouer(MyApplication,Param,MyVideo)
'***********************************************************************************************
Sub Jouer(MyApplication,Param,MyVideo)
    Dim MyFolder,FILE_EXE,MaCmd,i
    MyApplication = Split(MyApplication,"\")
    For i = 0 to UBound(MyApplication) - 1
        MyFolder = MyFolder & MyApplication(i) & "\"
    Next
    FILE_EXE = MyApplication(UBound(MyApplication))
    MyApplication = "CD /D "& DblQuote(MyFolder) & " & Start " & FILE_EXE & Param
    MyVideo = DblQuote(MyVideo)
    MaCmd = MyApplication &" "& MyVideo
    Call Executer(Macmd,0)'Démarrer la vidéo en plein écran sans afficher la console MS-DOS
End Sub
'***********************************************************************************************
Function Executer(StrCmd,Console)
    Dim ws,MyCmd,Resultat
    Set ws = CreateObject("wscript.Shell")
'La valeur 0 pour cacher la console MS-DOS
    If Console = 0 Then
        MyCmd = "CMD /C " & StrCmd & ""
        Resultat = ws.run(MyCmd,Console,False)
        If Resultat = 0 Then
        Else
            MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
        End If
    End If
'La valeur 1 pour montrer la console MS-DOS
    If Console = 1 Then
        MyCmd = "CMD /K " & StrCmd & " "
        Resultat = ws.run(MyCmd,Console,False)
        If Resultat = 0 Then
        Else
            MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
        End If
    End If
    Executer = Resultat
End Function
'**********************************************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************

et ceci avec Wmplayer.exe :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Option Explicit
Dim MyApplication,Param,MyVideo
MyApplication = "%Programfiles%\Windows Media Player\Wmplayer.exe" 'Chemin du programme
Param = " /fullscreen /Close" 'Paramètres plein écran et fermer toutes les instances de wmpnscfg.
MyVideo = "C:\Users\Mehdi\Documents\Camtasia Studio\MatrixLogin\MatrixLogin.mp4" 'Chemin de la vidéo à ouvrir
Call Jouer(MyApplication,Param,MyVideo)
'***********************************************************************************************
Sub Jouer(MyApplication,Param,MyVideo)
    Dim MyFolder,FILE_EXE,MaCmd,i
    MyApplication = Split(MyApplication,"\")
    For i = 0 to UBound(MyApplication) - 1
        MyFolder = MyFolder & MyApplication(i) & "\"
    Next
    FILE_EXE = MyApplication(UBound(MyApplication))
    MyApplication = "CD /D "& DblQuote(MyFolder) & " & Start " & FILE_EXE & Param
    MyVideo = DblQuote(MyVideo)
    MaCmd = MyApplication &" "& MyVideo
    'MsgBox MaCmd 'Juste pour déboguer la commande à passer dans la fonction
    Call Executer(Macmd,0)'Démarrer la vidéo en plein écran sans afficher la console MS-DOS
End Sub
'***********************************************************************************************
Function Executer(StrCmd,Console)
    Dim ws,MyCmd,Resultat
    Set ws = CreateObject("wscript.Shell")
'La valeur 0 pour cacher la console MS-DOS
    If Console = 0 Then
        MyCmd = "CMD /C " & StrCmd & ""
        Resultat = ws.run(MyCmd,Console,False)
        If Resultat = 0 Then
        Else
            MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
        End If
    End If
'La valeur 1 pour montrer la console MS-DOS
    If Console = 1 Then
        MyCmd = "CMD /K " & StrCmd & " "
        Resultat = ws.run(MyCmd,Console,False)
        If Resultat = 0 Then
        Else
            MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
        End If
    End If
    Executer = Resultat
End Function
'**********************************************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************

Pour les chemins relatives, j'ai trouvé ceci ==> How do I embed video in PowerPoint with relative paths ?
mais pas encore testé :roll:

30/04/2014, 10h34
Rick Dangerous

Bonjour,

Merci pour cette réponse !
En fait, je ne peux pas vraiment utiliser VLC, parce que je ne sais pas si l'utilisateur l'aura installé sur sa machine. Quant à Windows Media Player, c'est quasiment impossible de lui faire afficher des sous-titres. Donc la vraie solution simple que j'avais trouvé, c'est Media Player Classic, qui est très léger, performant, lit automatiquement les sous-titres, et existe en version exécutable sans installation préalable !

Le problème avec ces codes est donc qu'ils prennent en compte les répertoire d'installation des applications.

Mais pour ce problème de chemin relatifs, j'ai peut-être trouvé quelque chose en passant par le VBA de Power Point. La fonction ActivePresentation.Path me donne le chemin d'accès de la présentation. Donc après, si tout le reste se trouve dans des sous dossiers, c'est très simple.

La seule chose que je ne peux pas vérifier pour l'instant, c'est si mon code VBA sera bien lu sur toutes les machines, étant donné que ça s'exécute comme macro, et que pour des questions de sécurité, c'est souvent bloqué...