mutzik
XLDnaute Barbatruc
Re : [VBA] La macro ultime (POUR CEUX QUI SAVENT LA VERITE) - Ne pas DIFFUSEZ -
Allez, zou !
collez moi ce code dans un module et hop !!
Option Explicit
'auteur: Modeste
'source
'MPFE
Private Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long
'-------------------------------
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 midiOutShortMsg Lib "winmm.dll" _
(ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long
'---------------------------------------------------
Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Dim hMidiOut As Long
Public note As Long
'-------------------------------
Sub notesmidi()
Dim i, nbnotes, temps, dataNotes, dataTemps
' do=50 ré=52 mi=54 fa=55 sol=57 la=59 si=61 do=62
dataNotes = "505554555752575554525455"
dataTemps = "100100075125100100200100100050100400"
For i = 1 To Len(dataNotes) / 2
note = Mid(dataNotes, i * 2 - 1, 2)
temps = Mid(dataTemps, i * 3 - 2, 3)
note = RGB(144, note, 255) 'old 144, i, 127
'si aucun son emis : incrémenter le 1er 0 ci-dessous
midiOutOpen hMidiOut, 1, 0, 0, 0
midiOutShortMsg hMidiOut, note
Sleep (temps * 6) ' durée entre notes
Next
midiOutClose hMidiOut
End Sub
Allez, zou !
collez moi ce code dans un module et hop !!
Option Explicit
'auteur: Modeste
'source
'MPFE
Private Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long
'-------------------------------
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 midiOutShortMsg Lib "winmm.dll" _
(ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long
'---------------------------------------------------
Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Dim hMidiOut As Long
Public note As Long
'-------------------------------
Sub notesmidi()
Dim i, nbnotes, temps, dataNotes, dataTemps
' do=50 ré=52 mi=54 fa=55 sol=57 la=59 si=61 do=62
dataNotes = "505554555752575554525455"
dataTemps = "100100075125100100200100100050100400"
For i = 1 To Len(dataNotes) / 2
note = Mid(dataNotes, i * 2 - 1, 2)
temps = Mid(dataTemps, i * 3 - 2, 3)
note = RGB(144, note, 255) 'old 144, i, 127
'si aucun son emis : incrémenter le 1er 0 ci-dessous
midiOutOpen hMidiOut, 1, 0, 0, 0
midiOutShortMsg hMidiOut, note
Sleep (temps * 6) ' durée entre notes
Next
midiOutClose hMidiOut
End Sub