XL 2016 jouer un accord a partir d'excel

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 lanote As Integer
 Public Const durée As Integer = 250 ' millisecondes'
 
 Sub Au_clair_de_la_lune()
 Numéro = 0
 notes_a_jouer = Array(51, 51, 51, 53, 55, 53, 51, 55, 53, 53, 51, _
 51, 51, 51, 53, 55, 53, 51, 55, 53, 53, 51, _
 53, 53, 53, 53, 48, 48, 53, 51, 50, 48, 46, _
 51, 51, 51, 53, 55, 53, 51, 55, 53, 53, 51)
  For Each noteG In notes_a_jouer
  Numéro = Numéro + 1
  dur_n = Array(600, 600, 600, 600, 600, 600, 300, 300, 300, 300, 600, _
  300, 300, 300, 300, 600, 600, 300, 300, 300, 300, 600, _
  300, 300, 300, 300, 600, 600, 300, 300, 300, 300, 600, _
  300, 300, 300, 300, 600, 600, 300, 300, 300, 300, 600)
  Temps = dur_n(Numéro - 1)
  On Error GoTo fin
  midiOutClose hMidiOut '------------- ferme le port midi pour arreter la note précédente
  midiOutOpen hMidiOut, 0, 0, 0, 0 ' ----------------ouvre le port pour la nouvelle note
  midiOutShortMsg hMidiOut, RGB(192, 54 - 1, 127) 'ici, le nombre 51 peut être changé
 'par un nombre de 1 à 128
  lanote = 12 + CInt(noteG) ' -----on calcule la note / l'octave
  note = RGB(144, lanote, 127) '-----------------------astuce pour generer un entier long
  midiOutShortMsg hMidiOut, note ' --------------------on envoie la note sur le port MIDI
 Sleep (Temps)
fin:
 midiOutClose hMidiOut
   Next
  midiOutClose hMidiOut
  End Sub

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 lanote As Integer
 Public Const durée As Integer = 250 ' millisecondes'
 
 
 Sub Au_clair_de_la_lune()
notes_a_jouer = Array(51, 51, 51, 53, 55, 53, 51, 55, 53, 53, 51, _
 51, 51, 51, 53, 55, 53, 51, 55, 53, 53, 51, _
 53, 53, 53, 53, 48, 48, 53, 51, 50, 48, 46, _
 51, 51, 51, 53, 55, 53, 51, 55, 53, 53, 51)

dur_n = Array(350, 350, 350, 600, 600, 600, 300, 300, 300, 300, 600, _
  300, 300, 300, 300, 600, 600, 300, 300, 300, 300, 600, _
  300, 300, 300, 300, 600, 600, 300, 300, 300, 300, 600, _
  300, 300, 300, 300, 600, 600, 300, 300, 300, 300, 600)
  joue notes_a_jouer, dur_n
 End Sub

Sub DoDo() '8 octaves
MsgBox " orange " & RGB(255, 255, 0)
Dim DDo, Dorémifasollasido
'joue les do sur 8 octaves
DDo = Array(23, 31, 39, 47, 55, 63, 71, 79)
joue DDo, Array(600, 600, 600, 600, 600, 600, 600, 600)


'joue  do ré mi fa sol la si do de l'octave 4
Dorémifasollasido = DDo
For i = 0 To UBound(DDo)
Dorémifasollasido(i) = DDo(4) + i
Next
joue Dorémifasollasido, Array(600, 600, 600, 600, 600, 600, 600, 600)

End Sub


Sub joue(notes_a_jouer, dur_n)
  Numéro = 0
   For Each noteG In notes_a_jouer
  Numéro = Numéro + 1
   Temps = dur_n(Numéro - 1)
  On Error GoTo fin
  midiOutClose hMidiOut '------------- ferme le port midi pour arreter la note précédente
  midiOutOpen hMidiOut, 0, 0, 0, 0 ' ----------------ouvre le port pour la nouvelle note
  midiOutShortMsg hMidiOut, RGB(128, 53, 127) 'ici, le nombre 51 peut être changé(instrument)
 'par un nombre de 1 à 128
  lanote = 14 + CInt(noteG) ' -----on calcule la note / l'octave
  note = RGB(144, lanote, 127) '-----------------------astuce pour generer un entier long( la note)
  midiOutShortMsg hMidiOut, note ' --------------------on envoie la note sur le port MIDI
 Sleep (Temps)
fin:
 midiOutClose hMidiOut
   Next
  midiOutClose hMidiOut
  End Sub

Sub test()
son = "H:\mes musique\Amy Mc Donald\This is the Life - Amy Mac Donald\02 - This is the life2.mp3"
joue_le_son son
End Sub


Function joue_le_son(son)
    Dim code$, x&, w As Object
    code = code & "fichier= Wscript.ScriptFullName" & vbCrLf
    code = code & " Set wmp = CreateObject(""WMPlayer.OCX"")" & vbCrLf
    code = code & "wmp.settings.autoStart = True" & vbCrLf
    code = code & "wmp.settings.volume = 100" & vbCrLf
    code = code & "wmp.URL = """ & son & """" & vbCrLf
    code = code & "While wmp.Playstate <> 1" & vbCrLf
    code = code & "WScript.Sleep 1" & vbCrLf
    code = code & "Wend" & vbCrLf
    code = code & "Set fso = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf
    code = code & "fso.DeleteFile (fichier)" & vbCrLf
    code = code & "Set fso = Nothing" & vbCrLf
    fichier = ThisWorkbook.Path & "\jouer le son.vbs"
    x = FreeFile
    Open fichier For Output As #x
    Print #x, code
    Close #x
    Set w = CreateObject("Wscript.shell")
    w.Run """" & fichier & """"
End Function