Page créée par SilkyRoad
pour le  site http://www.developpez.com
mise à jour le  10.06.2006


Vous trouverez ci joint quelques exemples pour piloter Windows Media Player depuis Excel

la source utilisée : 
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmplay10/mmp_sdk/windowsmediaplayer activexcontrol.asp 
(il s'agit de codes JScript que j'ai essayé d'adapter ) 

Testé avec Excel2002 et Windows Media Player 10.0 


 

Démarrer une séquence musicale
**************************************

Wmp.URL = "C:\Documents and Settings\michel\dossier\monFichier.mid"
Wmp.Controls.Play


Arreter la séquence
***********************

Wmp.Controls.stop



Afficher la durée de la séquence musicale en cours
***********************************************************

Dim ValMin As Double, ValSec As Double, S As Double
Wmp.URL = "C:\monFichier.mp3"
While Wmp.PlayState = 9: DoEvents: Wend

S = Wmp.currentMedia.Duration
ValMin = Application.WorksheetFunction.RoundDown((S / 60), 0)
ValSec = Application.WorksheetFunction.RoundDown(S, 0) - (ValMin * 60)
MsgBox Format(ValMin, "00") & ":" & Format(ValSec, "00")



Effectuer une pause de 5 secondes dans la séquence musicale
*************************************************************************

Dim t As Date
Wmp.Controls.Pause
'
'temporisation de 5 secondes
t = Timer + 5: Do Until Timer > t: DoEvents: Loop
'pour relancer
Wmp.Controls.Play
End Sub



'vérifier si l'action "Pause" peut etre appliquée
****************************************************
( renvoie Vrai ou faux )

MsgBox Wmp.Controls.isAvailable("Pause")



Afficher le statut de Windows Media Player
*************************************************

MsgBox Wmp.Status



Afficher le statut de Windows Media Player ( un autre exemple )
*************************************************

Select Case Wmp.playState
Case 0: MsgBox "Undefined"
Case 1: MsgBox "Stopped"
Case 2: MsgBox "Paused"
Case 3: MsgBox "Playing"
Case 4: MsgBox "ScanForward" 'fast forwarding
Case 5: MsgBox "ScanReverse" 'fast rewinding
Case 6: MsgBox "Buffering"
Case 7: MsgBox "Waiting"
Case 8: MsgBox "MediaEnded"
Case 9: MsgBox "Transitioning" 'Preparing new media item
Case 10: MsgBox "Ready"
Case 11: MsgBox "Reconnecting"
End Select



Désactiver ou Activer le son
*******************************

Wmp.settings.mute = True

Wmp.settings.mute = False




Afficher la version de Windows Media player installée
*************************************************************

MsgBox Wmp.versionInfo



Effectuer une avance rapide sur la séquence , pendant 3 secondes
****************************************************************************

Dim t As Date
If Wmp.Controls.isAvailable("FastForward") Then Wmp.Controls.fastForward
'
'temporisation de 3 secondes
t = Timer + 3: Do Until Timer > t: DoEvents: Loop
'pour revenir à la vitesse normale
Wmp.Controls.Play




Le nom du fichier en cours de lecture
******************************************

Dim Cm As Object
Set Cm = Wmp.currentMedia
MsgBox Cm.Name




Informations sur la séquence en cours
********************************************

Sub informationSequenceEnCours()
MsgBox Wmp.currentMedia.getItemInfo("author")
MsgBox Wmp.currentMedia.getItemInfo("Title")
MsgBox Wmp.currentMedia.getItemInfo("Album")
MsgBox Wmp.currentMedia.getItemInfo("copyright")
MsgBox Wmp.currentMedia.getItemInfo("Artist")
MsgBox Wmp.currentMedia.getItemInfo("Genre")
MsgBox Wmp.currentMedia.getItemInfo("Bitrate") / 1000 & " kbps"
MsgBox Wmp.currentMedia.getItemInfo("Abstract")
MsgBox Wmp.currentMedia.getItemInfo("bitRate")
MsgBox Wmp.currentMedia.getItemInfo("duration")
End Sub

une autre solution qui liste toutes les informations :

Sub informationsSequence_WMP()
Dim Resultat As String
Dim i As Integer
Dim Cm As WMPLib.IWMPMedia
Set Cm = Wmp.currentMedia

For i = 0 To Cm.attributeCount - 1
If Cm.getItemInfo(Cm.getAttributeName(i)) <> "" Then _
Resultat = Resultat & Cm.getAttributeName(i) & " : " & _
Cm.getItemInfo(Cm.getAttributeName(i)) & vbLf
Next
MsgBox Resultat
End Sub



Modifier le titre d'une séquence
***********************************

Sub modifierTitreSequence()
Dim Xwmp As IWMPMedia
Dim Chemin As String

Chemin = "C:\Documents and Settings\michel\dossier musique"
Wmp.currentPlaylist.Clear
  
Set Xwmp = Wmp.newMedia(Chemin & "\fragancia.mid")
Wmp.currentPlaylist.insertItem 0, Xwmp
Xwmp.setItemInfo "title", "Nom_Du_Titre" 'modifie le titre
DoEvents

Wmp.Controls.Play
'testé OK avec des fichiers .mid , .wma
'à revoir pour les type .mp3
MsgBox Wmp.currentMedia.getItemInfo("title") 'vérifie le titre modifié
End Sub



Modifier le volume sonore 
*****************************
(valeurs de 0 à 100 % )

Wmp.settings.volume = 50






@@@@@     La gestion des PlayList         @@@@@


Créer une PlayList de plusieurs séquences et les jouer à la suite
**************************************************************************

Sub ajout_PlusieurSequences_PlayList_Et_Lance_Sequence()
Dim Xwmp As IWMPMedia

Set Wmp = CreateObject("WMPlayer.OCX.7")
Wmp.currentPlaylist.Clear
     
Set Xwmp = Wmp.newMedia("C:\essai.mid") 'adapter les noms de fichiers
Wmp.currentPlaylist.insertItem 0, Xwmp
  
Set Xwmp = Wmp.newMedia("C:\maMusique.mp3")
Wmp.currentPlaylist.insertItem 1, Xwmp

Set Xwmp = Wmp.newMedia("C:\Jumbalaya.mid")
Wmp.currentPlaylist.insertItem 2, Xwmp

Wmp.Controls.Play
End Sub


nota:
-------
ne pas oublier de créer un bouton pour arreter la boucle

Wmp.Controls.stop



Pour passer à la séquence suivante ou précédente
*********************************************************

Sub passerSequenceSuivante()
Wmp.Controls.Next
End Sub

Sub passerSequencePrecedente()
Wmp.Controls.Previous
End Sub



Supprimer la deuxieme séquence dans la playlist
*********************************************************
remarque : l'index du premier élément = 0

Sub supprimer_SequenceDansPlayList()
Dim It As Object
Set It = Wmp.currentPlaylist.Item(1)
Wmp.currentPlaylist.RemoveItem It
End Sub



Lancer une séquence spécifique de la playlist ( exemple le 3 eme item )
***********************************************************************************

Sub JouerUneSequenceSpecifique()
Dim It As Object
Set It = Wmp.currentPlaylist.Item(2)
Wmp.Controls.playItem It
End Sub



Lister le nom des séquences contenues dans la PlayList
****************************************************************

Sub Lister_NomDesSequences_DansLaPlayList()
Dim Pl As IWMPPlaylist
Dim j As Integer, i As Integer
  
Set Pl = Wmp.currentPlaylist
j = Pl.Count
If Not j > 0 Then MsgBox "il n'y a pas d'éléments dans la playlist"
  
For i = 0 To j - 1
MsgBox Pl.Item(i).Name
'
'pour afficher la source :
'MsgBox Pl.Item(i).sourceURL
'
Next i
End Sub



Ajouter une séquence musicale dans la PlayList
********************************************************
( la séquence est automatiquement placée à la suite des items existants )

Dim Ad As IWMPMedia
Set Ad = Wmp.newMedia("C:\couldntStandTheWeather.mp3") 'adapter le chemin
Wmp.currentPlaylist.appendItem Ad



Insérer 3 séquences dans la PlayList et en jouer une au hasard
*************************************************************************

Sub lancerSequenceAleatoire()
Dim NombreItem As Integer, Aleat As Integer
Dim Xwmp As IWMPMedia

Wmp.currentPlaylist.Clear
     
Set Xwmp = Wmp.newMedia("C:\fragancia.mid")
Wmp.currentPlaylist.insertItem 0, Xwmp
  
Set Xwmp = Wmp.newMedia("C:\maMusique.mp3")
Wmp.currentPlaylist.insertItem 1, Xwmp

Set Xwmp = Wmp.newMedia("C:\Jumbalaya.mid")
Wmp.currentPlaylist.insertItem 2, Xwmp

'------------------------------------------------------
NombreItem = Wmp.currentPlaylist.Count
Randomize
Aleat = Int((NombreItem * Rnd) + 1)
'------------------------------------------------------
Wmp.currentMedia = Wmp.currentPlaylist.Item(Aleat - 1)
Wmp.Controls.Play
End Sub




@@@@@    Lancer une séquence video et Divers     @@@@@



Lancer une video ( sans lien avec les exemples précédents )
*******************

Sub lancerUneVideo()
Dim Wmp As WindowsMediaPlayer
Set Wmp = CreateObject("WMPlayer.OCX.7")
Wmp.openPlayer "C:\monFilm.mpg"
End Sub



Lister les lecteurs de CD et de DVD installés
***************************************************

Sub listeLecteurs_CD_DVD()
Dim iNumDrives As Integer, i As Integer
Dim oThisDrive As IWMPCdrom
  
iNumDrives = Wmp.cdromCollection.Count
If Not iNumDrives > 0 Then MsgBox "il n'y a pas de lecteur de CD ou DVD installés ."
  
For i = 0 To iNumDrives - 1
Set oThisDrive = Wmp.cdromCollection.Item(i)
MsgBox oThisDrive.driveSpecifier
Next i
End Sub



Ouvrir le lecteur de CD ou de DVD
***************************************
Dans cet exemple , 0 est l'index du 1er lecteur

Sub ouvrirLecteur() 
Dim Lecteur As Object 
Set Lecteur = Wmp.cdromCollection.Item(0) 
Lecteur.eject 
End Sub 



Retrouver l'index d'une séquence dans une playlist
**********************************************************

Dim Pl As IWMPPlaylist
Dim j As Integer, i As Integer
Dim Cible As String

Cible = WindowsMediaPlayer1.Controls.currentItem.Name

Set Pl = WindowsMediaPlayer1.currentPlaylist
j = Pl.Count
If Not j > 0 Then MsgBox "il n'y a pas d'éléments dans la playlist"
  
For i = 0 To j - 1
If Cible = Pl.Item(i).Name Then
MsgBox "L'index de la séquence " & Cible & " est : " & i
Exit For
End If
Next i



Compter le nombre de séquences dans la playlist
*********************************************************

WindowsMediaPlayer1.currentPlaylist.Count



Lire la meme séquence en boucle
***************************************

WindowsMediaPlayer1.URL = "C:\maMusique.mid"
WindowsMediaPlayer1.Controls.Play
WindowsMediaPlayer1.settings.setMode "loop", True



Intercepter le changement de statut d'un objet Windows Media Player 
***************************************************************************
en utilisant l'evenement "playStateChange" 

Private Sub WindowsMediaPlayer1_PlayStateChange(ByVal NewState As Long) 
If WindowsMediaPlayer1.Status = "Arrêté" Then MsgBox "terminé" 
'd'autres exemples de statuts : 
'Connexion en cours... 
'Lecture en cours 
'Opération terminée 
'Ouvrir le média 
'Prêt 
'Arrêté 
'Modification du média en cours... 
End Sub 



Utiliser Windows Media Player pour afficher un message personnalisé
********************************************************************************

Sub afficherMessagePersonnalise_Dans_WindowsMediaPlayer()
'MichelXld le 19.02.2006
'Wmp doit etre affiché en "mode complet" pour visualiser le message
Dim Wmp As Object
Dim Fichier As String

Set Wmp = CreateObject("WMPlayer.OCX.7")
Fichier = "C:\messagePerso_WMP.smi"

Open Fichier For Output As #1
Print #1, "<SAMI><HEAD><STYLE TYPE=""text/css""><!--"
Print #1, "P {font-family: Dolphin;font-weight:" _
& " bold;color: #000FFF;background: #FFF000;text-align: center;}"
Print #1, ".Captions { Name: Captions; lang: FR; }"
Print #1, "--></STYLE></HEAD>"
Print #1, "<BODY><SYNC Start=""500""><P Class=""Captions"">Bonjour le forum Developpez.com</P></SYNC>"
Print #1, "<SYNC Start=""4000""><P Class=""Captions"">Ceci est un essai de message dans WMP</P></SYNC>"
Print #1, "<SYNC Start=""6000""><P Class=""Captions"">&nbsp;</P></SYNC></BODY></SAMI>"
Close

Wmp.openPlayer Fichier
End Sub



Afficher ou Masquer la barre de controles de l'objet Windows Media Player
**************************************************************************************
Dans la propriété uiMode , indiquez la valeur "none"

Pour afficher la barre de controles , indiquez la valeur "full"