XL 2016 jouer un accord a partir d'excel

[Big66677]

Bonjour,
j'ai un classeur ou j'ai harmonisé la gamme de Do.
je voudrais si c'est possible produire un son lorsque je clique sur une case.
bien sûr l'accord est stocké dans un fichier au format MP3
Merci

 

[patricktoulon]

et pourquoi n'utiliserait tu pas le midioutput
tu n'aurais besoins de rien d'autre que du code

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

à adapter en 64 bit pour les api al"époque je n'en avais pas besoins
c'est 200 à la place de 192 pour le piano

 

[Modeste geedee]

Bonsour

et pourquoi n'utiliserait tu pas le midioutput

Pourrais-tu expliciter l'utilisation ici de la fonction RGB ?

 

[patricktoulon]

re

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

Bonjour Modeste geedee
la fonction rgb me sert a obtenir un long déterminant la note l'octave , l'instrument ( si je puis m'exprimer ainsi)
c'est comme pour la couleur
exemple
msgbox " orange " & rgb(255,255,0)) qui me donne 65535

après pour être honnête je suis pas sur si pour les octave on saute de 8 en 8 ou de 16 en 16
j'ai pas l'oreille musicale moi pour moi ça n'est que du bruit
celui qui sait n'a qu'a le dire je corrigerais dans l'archive

 

[VIARD]

Bonjour Big, Patrick, Modeste geedee

Très astucieux le coup du RGB, j'apprécie.
Au clair de la lune et pourquoi pas Big-Ben.

'==================
Declare Function Beep Lib "kernel32" (ByVal Frequence As Long, ByVal Duree As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'==================
Sub Test_BIG_BEN_2() 'série de 4 notes (Sol#4, Fa#4, Mi4, Si3
Dim i%, Note(), Durée() 'le Si portée inférieure (octave)

Note = Array("", 330, 412.5, 371.25, 233.08, _
                330, 371.25, 412.5, 330, _
                412.5, 330, 371.25, 233.08, _
                233.08, 371.25, 412.5, 330)
Durée = Array("", 400, 400, 400, 600, _
                400, 400, 400, 600, _
                400, 400, 400, 600, _
                400, 400, 400, 600)
For i = 1 To 16
    Beep Note(i), Durée(i)
Next i
End Sub
'==================

@+ Jean-Paul

 

[Big66677]

bonjour
je pense mettre mal expliqué.
Je veux jouer un fichier MP3 placé dans un dossier,en cliquant sur une case.
il ne s'agit pas d'une note mais d'un accord de trois son Do Mi Sol soit do majeur.
------
J'ai bien essayé Insertion ---> objet mais rien on peut insérer plein de chose sauf MP3.
---------
l’idéal c'est que cela se face sans code ...
merci

 

[patricktoulon]

re
et alors tu peux le faire avec midi aussi si tu cherche bien tu trouve

mais si tu insiste
voici comment on joue un mp3 sans avoir a ouvrir l'interface de Wmediaplayer
ça te créée un vbs temporaire auto destructible qui lance l'ocx (plus accessible de vba depuis un moment déjà )

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

tout droit sorti de la boite a astuce de patrick

 

[Modeste geedee]

celui qui sait n'a qu'a le dire je corrigerais dans l'archive

à l'époque je n'en avais pas besoins ???

à propos d'archive ... 2002 !!!

Jouer un son dans Excel 2000

groups.google.com

[

 

[patricktoulon]

re
Bonjour @Modeste geedee
j'avais un fichier similaire un peu plus évolué avec des guitares et de la batterie
que j'avais péché sur vbforum france je crois ou sur codes source
mais je ne sais plus ou il est
mais visiblement depuis toute ces années rien a changé avec cet api il arrive que plus rien ne sorte
soit que le port ne soit pas fermé ou je ne sais quoi qu'est ce
je viens d'en faire encore l'expérience avec le tiens
ça peu pas être moi ou le pc j'ai changé pas mal de fois de matos depuis

obligé de fermer le fichier et le ré ouvrir pour que ça re fonctionne

 

[Modeste geedee]

obligé de fermer le fichier et le ré ouvrir pour que ça re fonctionne

Dans le fil de discussion à ce sujet sur DailyDoseOfExcel un contributeur avait positionné judicieusement une instruction midiReset .

A propos de virtual drummer que j'avais soumis à l époque à JW ... il y avait en plus l'utilisation des tablatures batterie.
De même que l'adaptation sonore(midi) du fichier gammes et accords de JW... et tablatures guitare.
Je n'ai plus mes sources et fichiers de originaux concernant Ces pièces de codes,
Mais elles etaient accessibles sur "feux" Excelabo et en partie sur MPFE


Temps fugit ...

 

[mapomme]

et pourquoi n'utiliserait tu pas le midioutput

Pour vous saluer

Et si on veut jouer jouer la petite mélodie à une autre heure que midi, ça marche aussi ?
Bon, désolé, je sors...

 

[patricktoulon]

oui je les avais aussi ces sources mais quand j'avais grillé mon DD j'avais tout perdu
j'avais heureusement en copie sur un autre DD les liens d'ou j'avais eu les sources mais je les ai effacé après r 'avoir refait ma biblio et je n'avais pas tout gardé malheureusement

mais bon ton piano fonctionne
mais de temps en temps reset ou pas le port midi n'est pas fermé et ça devient silencieux
je retrouve plus ma version piano avec le clavier 4 octaves utilisant les touches du clavier
avec celui là j'avais résolu le problème je ne sais plus comment
j 'enregistrais les notes et les durées en même temps que je pianotait pour le rejouer
il faudrait que je me démerde un support externe pour mes vieux disques durs pour que je puisse retrouver ces trucs rigolos
je dois bien avoir un trucs ou deux encore

 

[Modeste geedee]

je retrouve plus ma version piano avec le clavier 4 octaves utilisant les touches du clavier
avec celui là j'avais résolu le problème je ne sais plus comment
j 'enregistrais les notes et les durées en même temps que je pianotait pour le rejouer

celui-là sans doute ?

ou bien encore :

ou même celu-ci :

tout était en libre accès sur Excelabo !!!!

A l'époque (2002) j'étais encore en activité,
tout était en .Xls que je n'ai jamais su convertir en .XLSM
depuis je n'ai plus la disponibilité ni la passion pour y remédier.

 

[Victor21]

Bonsoir, @Modeste geedee

Seraient-ce ces fichiers ?

 

[patricktoulon]

re
Bonjour @Victor @Modeste geedee
a ben cela je les connaissais pas merci
le piano

la new guitare déconne purée j'ai mis a fond
et les notes reste bloqué ca a fait un ramdam je vous dis pas

et ils ont tous le même problème
c'est que des qu'il se passe une erreur dans le code même si ça concerne pas le midioutput ben il devient silencieux

sndrec32.exe je suppose que c'est l'enregistreur pas dispo chez moi

mais c'est pas comme ça que j'enregistrais sur le mien

j'enregistrais simplement les notes et les espaces entre les notes sur une feuille
cela dit ca doit etre remediable sur ces fichier

les bouton genere des erreurs (changement de couleur etc