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
| '*** LANCE UN FILM SUR DOUBLE CLIC DANS LA LISTE COLONNE A
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Chemin As String: Dim Fichier As String: Dim Shp As Shape: Dim Retval As Long: Dim ID As Variant
Application.ScreenUpdating = False
'
If Not Intersect(Target, Range("A2:A" & [A3000].End(xlUp).Row)) Is Nothing Then
Cancel = True
Chemin = "E:\Videos\"
Fichier = "E:\Affiche\" & Target.Value & ".jpg"
End If
'
'*** APPEL DU FILM CHOISI DANS LA COLONNE A
ID = Shell("""C:\Program Files\Windows Media Player\wmplayer.exe"" """ & Chemin & Target & ".avi", vbMaximizedFocus)
Retval = ExecCmd("Wmplayer.exe" )
'
'*** APPEL DE L'IMAGE CORRESPONDANT AU FILM L T W H
On Error Resume Next
Set Shp = Feuil1.Shapes.AddPicture(Fichier, msoFalse, msoCTrue, 945, 196, 194, 240)
On Error GoTo 0
Fichier = IIf(Shp Is Nothing, "E:\Affiche\Liberty.jpg", Fichier)
Set Shp = Feuil1.Shapes.AddPicture(Fichier, msoFalse, msoCTrue, 945, 196, 194, 240)
Shp.Name = Fichier
'
Application.ScreenUpdating = True
'*** ARRET DU LECTEUR ET EFFACE L'AFFICHE
If Retval = -1 Then MsgBox "Windows média player est arrêter."
Shp.Delete
End Sub |
Partager