Son midi en VBA
marcod59
Messages postés
170
Date d'inscription
vendredi 16 janvier 2004
Statut
Membre
Dernière intervention
13 juin 2010
-
20 mai 2006 à 19:02
marcod59 Messages postés 170 Date d'inscription vendredi 16 janvier 2004 Statut Membre Dernière intervention 13 juin 2010 - 21 mai 2006 à 14:48
marcod59 Messages postés 170 Date d'inscription vendredi 16 janvier 2004 Statut Membre Dernière intervention 13 juin 2010 - 21 mai 2006 à 14:48
4 réponses
cs_Willi
Messages postés
2375
Date d'inscription
jeudi 12 juillet 2001
Statut
Modérateur
Dernière intervention
15 décembre 2018
22
21 mai 2006 à 10:41
21 mai 2006 à 10:41
Bonjour,
Voir http://www.allapi.net/apilist/mciSendString.shtml
Voir http://www.allapi.net/apilist/mciSendString.shtml
marcod59
Messages postés
170
Date d'inscription
vendredi 16 janvier 2004
Statut
Membre
Dernière intervention
13 juin 2010
21 mai 2006 à 14:10
21 mai 2006 à 14:10
Bonjour Willi,
Ton lien et pour du VB. J'ai déjà un code en VB, mais il ne fonctionne pas en VBA. Ce code concerne également la fonction mciSendString. Il est possible que je l'utilise mal, mais je ne vois pas où.
Merci tout de même pour ta réponse.
@+++
marcod59
Ton lien et pour du VB. J'ai déjà un code en VB, mais il ne fonctionne pas en VBA. Ce code concerne également la fonction mciSendString. Il est possible que je l'utilise mal, mais je ne vois pas où.
Merci tout de même pour ta réponse.
@+++
marcod59
cs_Willi
Messages postés
2375
Date d'inscription
jeudi 12 juillet 2001
Statut
Modérateur
Dernière intervention
15 décembre 2018
22
21 mai 2006 à 14:40
21 mai 2006 à 14:40
Peux tu donner le code que tu utilises.
marcod59
Messages postés
170
Date d'inscription
vendredi 16 janvier 2004
Statut
Membre
Dernière intervention
13 juin 2010
21 mai 2006 à 14:48
21 mai 2006 à 14:48
Private Declare Function mciExecute Lib "winmm.dll" _
(ByVal lpstrCommand As String) As Long
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function sndPlaySoundA Lib "winmm.dll" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" _
(ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const snd_filename = &H20000
'==================================================================================
Sub Jouer_la_musique()
Dim Pays As String
Dim filePath As String
DoEvents
' jouer la musique
filePath = ActiveWorkbook.path & "\musique\France.mid"
Call Musique_jouer(filePath) ' + pays) 'Musique_Nom)
End Sub
'==================================================================================
Public Function Musique_jouer(ByVal Fichier As String, _
Optional ByVal Alias As Variant) As Boolean
Dim nRet As Long
If IsMissing(Alias) Then Alias = "tune"
' stoppe la musique en cours d'exécution éventuellement
Call Musique_Stopper(Alias)
' On Error Resume Next
If mciSendString("open " & Fichier$ & " alias " & Alias, vbNullString, 0, 0) = 0 Then
nRet = mciSendString("play " & Alias & " from 0", vbNullString, 0, 0) Musique_jouer (nRet 0)
Else
MsgBox "Impossible de jouer la musique." + vbLf + vbLf + "Problème de fichier ou de compatibilité"
Musique_Stopper
End If
End Function
'==================================================================================
Public Sub Musique_Stopper(Optional ByVal Alias As Variant)
If IsMissing(Alias) Then Alias = "tune"
Call mciSendString("stop " & Alias, vbNullString, 0, 0)
Call mciSendString("close " & Alias, vbNullString, 0, 0)
End Sub
'==================================================================================
'---------------- Validation sur doubleClick de Userform ---------------
Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)
Dim Pays, toto As String
If target.Address <> "$E$3" Then
toto = target.Address
Call Jouer_la_musique
UserForm1.Show
End If
Cancel = True
End Sub
Je lance la macro Jouer_la_musique depuis une autre feuille. Aucune erreur ne se produit, mais je n'ai aucun son.
marcod59
(ByVal lpstrCommand As String) As Long
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function sndPlaySoundA Lib "winmm.dll" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" _
(ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const snd_filename = &H20000
'==================================================================================
Sub Jouer_la_musique()
Dim Pays As String
Dim filePath As String
DoEvents
' jouer la musique
filePath = ActiveWorkbook.path & "\musique\France.mid"
Call Musique_jouer(filePath) ' + pays) 'Musique_Nom)
End Sub
'==================================================================================
Public Function Musique_jouer(ByVal Fichier As String, _
Optional ByVal Alias As Variant) As Boolean
Dim nRet As Long
If IsMissing(Alias) Then Alias = "tune"
' stoppe la musique en cours d'exécution éventuellement
Call Musique_Stopper(Alias)
' On Error Resume Next
If mciSendString("open " & Fichier$ & " alias " & Alias, vbNullString, 0, 0) = 0 Then
nRet = mciSendString("play " & Alias & " from 0", vbNullString, 0, 0) Musique_jouer (nRet 0)
Else
MsgBox "Impossible de jouer la musique." + vbLf + vbLf + "Problème de fichier ou de compatibilité"
Musique_Stopper
End If
End Function
'==================================================================================
Public Sub Musique_Stopper(Optional ByVal Alias As Variant)
If IsMissing(Alias) Then Alias = "tune"
Call mciSendString("stop " & Alias, vbNullString, 0, 0)
Call mciSendString("close " & Alias, vbNullString, 0, 0)
End Sub
'==================================================================================
'---------------- Validation sur doubleClick de Userform ---------------
Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)
Dim Pays, toto As String
If target.Address <> "$E$3" Then
toto = target.Address
Call Jouer_la_musique
UserForm1.Show
End If
Cancel = True
End Sub
Je lance la macro Jouer_la_musique depuis une autre feuille. Aucune erreur ne se produit, mais je n'ai aucun son.
marcod59
