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
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.
Je ne comprend pas d'ou vient le problème
Merci d'avance
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 Longhttp://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 SubJe ne comprend pas d'ou vient le problème
Merci d'avance
Aucun commentaire:
Enregistrer un commentaire