Pages

Affichage des articles dont le libellé est jouer. Afficher tous les articles
Affichage des articles dont le libellé est jouer. Afficher tous les articles

Jouer de la musique avec VBA sujet

jeudi 30 janvier 2014




Bonjour à tous

J'ai longuement cherché sur internet mais je n'arrive pas à résoudre mon problème. Je cherche à jouer de la musique avec VBA. J'avais cru comprendre que c'était possible avec la LiB winmm.dll


Code:


Private Declare Function midiOutOpen Lib “winmm.dll” _
    (lphMidiOut As Long, _
    ByVal uDeviceID As Long, _
    ByVal dwCallback As Long, _
    ByVal dwInstance As Long, _
    ByVal dwFlags As Long) As Long
 
Private Declare Function midiOutClose Lib “winmm.dll” _
    (ByVal hMidiOut As Long) As Long
 
Private Declare Function midiOutShortMsg Lib “winmm.dll” _
    (ByVal hMidiOut As Long, _
    ByVal dwMsg As Long) As Long


J'ai essayé différents programmes comme celui ci:
http://dailydoseofexcel.com/archives...enbach/page/2/

Le programme tourne mais il y a aucun son. J'ai essayé avec un autre programme "Samba" (trouvé ici: http://www.generation-nt.com/reponse...221.html?tri=p). Ce programme a fonctionné 2 fois par intermittence mais ne fonctionne plus non plus depuis.


Code:


Private Type MIDIOUTCAPS
wMid As Integer
wPid As Integer
vDriverVersion As Long
szPname As String * 32
wTechnology As Integer
wVoices As Integer
wNotes As Integer
wChannelMask As Integer
dwSupport As Long
End Type
Private Declare Function midiOutGetDevCaps Lib _
"winmm.dll" Alias "midiOutGetDevCapsA" (ByVal uDeviceID _
As Long, lpCaps As MIDIOUTCAPS, ByVal uSize As Long) As Long
Private Declare Function midiOutGetNumDevs Lib "winmm" () As Integer

Private Declare Function MidiOutClose Lib "winmm.dll" _
Alias "midiOutClose" (ByVal hMidiOut As Long) As Long
'-------------------------------
Private Declare Function MidiOutOpen Lib "winmm.dll" _
Alias "midiOutOpen" (lphMidiOut As _
Long, ByVal uDeviceID As _
Long, ByVal dwCallback As _
Long, ByVal dwInstance As _
Long, ByVal dwFlags As Long) As Long
'-------------------------------
Private Declare Function MidiOutShortMsg Lib "winmm.dll" _
Alias "midiOutShortMsg" (ByVal hMidiOut As _
Long, ByVal dwMsg As Long) As Long
'---------------------------------------------------
Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Dim hMidiOut As Long
Public lanote As Integer

Sub samba()
'----- proc originale de Sitting Hoax MPFE
batterie = Array(48, 47, 56, 55)
Randomize
Application.EnableCancelKey = xlErrorHandler
On Error GoTo fin
For i = 1 To 250
Randomize
x = batterie(Int(Rnd * 4))
MidiOutClose hMidiOut
MidiOutOpen hMidiOut, 0, 1, 2, 0
xxx = CInt(x)
For z = 1 To 15
On Error GoTo fin
Randomize
MidiOutShortMsg hMidiOut, RGB(153, xxx, 127)
Sleep (Rnd * 150 + 70)
Next
Sleep (150)
For z = 1 To 10
For u = 1 To 5
Randomize
x = batterie(Int(Rnd * 4))
xxx = CInt(x)
MidiOutShortMsg hMidiOut, RGB(153, xxx, 127)
MidiOutShortMsg hMidiOut, RGB(153, xxx + 1, 127)
MidiOutShortMsg hMidiOut, RGB(153, xxx + 30, 127)
MidiOutShortMsg hMidiOut, RGB(153, xxx + 6, 127)
Sleep (100)
Next
Randomize
x = batterie(Int(Rnd * 4))
xxx = CInt(x)
MidiOutShortMsg hMidiOut, RGB(153, xxx, 127)
MidiOutShortMsg hMidiOut, RGB(153, xxx + 1, 127)
MidiOutShortMsg hMidiOut, RGB(153, xxx + 20, 127)
MidiOutShortMsg hMidiOut, RGB(153, xxx + 6, 127)
Sleep (Rnd * 200)
Next
For z = 1 To 10
Randomize
x = batterie(Int(Rnd * 4))
xxx = CInt(x)
MidiOutShortMsg hMidiOut, RGB(153, xxx, 127)
MidiOutShortMsg hMidiOut, RGB(153, xxx + 1, 127)
MidiOutShortMsg hMidiOut, RGB(153, xxx + 15, 127)
MidiOutShortMsg hMidiOut, RGB(153, xxx + 6, 127)
Sleep (100)
Next
Next
fin:
MidiOutClose hMidiOut
End Sub



Je ne comprend pas d'ou vient le problème

Merci d'avance