[VBA] La macro ultime (POUR CEUX QUI SAVENT LA VERITE) - Ne pas DIFFUSEZ -

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
 

Staple1600

XLDnaute Barbatruc
Re : [VBA] La macro ultime (POUR CEUX QUI SAVENT LA VERITE) - Ne pas DIFFUSEZ -

Bonjour Mutzik



Merci de ton implication

Malheureusement ton code ne fonctionne pas chez moi .


Même si je change
midiOutOpen hMidiOut, 1, 0, 0, 0
en
midiOutOpen hMidiOut, 0, 0, 0, 0

Le code exemple dans mon message de 14h48 lui fonctionne.


Je cherche pourquoi et te redis (si je trouve)
 

Staple1600

XLDnaute Barbatruc
Re : [VBA] La macro ultime (POUR CEUX QUI SAVENT LA VERITE) - Ne pas DIFFUSEZ -

Re

EDITION: pour tester lancer la macro: Elvis_chante_dans_mon_Excel

En utilisant le code * cité dans mon message de 11/04/2008, 20h28
(qui me parle plus) (et en mixant avec les infos de Mutzik (grand merci à toi )

• A copier dans un module standard
Code:
'Déclarations"
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

Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Dim hMidiOut As Long
Public lanote As Long
Code:
Sub PlayMIDI(voiceNum, noteNum, Duration)
    Dim Note As Long
    On Error Resume Next
    midiOutClose hMidiOut
    midiOutOpen hMidiOut, 0, 0, 0, 0
    midiOutShortMsg hMidiOut, RGB(192, voiceNum - 1, 127)
    lanote = 12 + CLng(noteNum)
    Note = RGB(144, lanote, 127)
    midiOutShortMsg hMidiOut, Note
    Sleep (Duration)
    midiOutClose hMidiOut
 End Sub

Sub Elvis_chante_dans_mon_Excel()
Dim r As Long
Dim vNum As Long
    
noteN = Split("50,55,54,55,57,52,57,55,54,52,54,55", ",")
duree = Split("100,100,75,125,100,100,200,100,100,50,100,400", ",")
vNum = 10  'ici on peut changer d'instrument de :1 à 127
'j'ai testé jusqu'à 125  OK)

  For r = 0 To 11
        Call PlayMIDI(vNum, noteN(r), duree(r) * 6)
Next r
End Sub
Mutzik: je n'ai pas trouvé comment faire fonctionner ton code
mais grâce à toi ok pour les notes et le "temps" des notes.

Si tu as le temps , peux-tu me dire quelles modifications faire dans ton code?

Merci.
 
Dernière édition:

mutzik

XLDnaute Barbatruc
Re : [VBA] La macro ultime (POUR CEUX QUI SAVENT LA VERITE) - Ne pas DIFFUSEZ -

re,

autre possibilité

'Pour jouer un fichier mid, il faut utiliser les API. Dans un module :
'Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
'Public Sub JouerMusique(ByVal Fichier As String)
'mciExecute ("play " & Fichier)
'End Sub
'Private Sub ArreterMusique(ByVal Fichier As String)
'mciExecute ("stop " & Fichier)
'End Sub

'Pour lancer la lecture :
'JouerMusique ("d:\town.mid")

'Pour arrêter:
'ArreterMusique ("d:\town.mid")
 

Staple1600

XLDnaute Barbatruc
Re : [VBA] La macro ultime (POUR CEUX QUI SAVENT LA VERITE) - Ne pas DIFFUSEZ -

Bonjour Mutzik, bonjour à tous



Comme je le disais
PS: je sais (grâce à la FAQ (pages WIKI de MichelXLD) que je pourrais jouer directement le fichier MIDI dans Excel, mais justement je voudrais faire
(comme le fait si bien Sitting Hoax sur mpfe) mettre les notes en dur dans le code VBA.)

Je voulais jouer quelques notes car je voulais éviter d'avoir à joindre un fichier mid avec le classeur.

(Sauf s'il est possible de "stocker" un fichier mid, comme on insére une image dans un classeur.)

En tout cas, merci pour ton aide précieuse, merci aussi à tous ceux qui se sont arrêtès dans ce fil.

mutzik: au fait, tu as réussi à faire fonctionner le code et à avoir du son alors?
 

mutzik

XLDnaute Barbatruc
Re : [VBA] La macro ultime (POUR CEUX QUI SAVENT LA VERITE) - Ne pas DIFFUSEZ -

et voili, une petite appli pour jouer du piano

amusez-vous bien
 

Pièces jointes

  • piano.zip
    53.5 KB · Affichages: 170

Staple1600

XLDnaute Barbatruc
Re : [VBA] Elvis, Excel, la musique, le midi

Bonsoir à tous


Bonsoir Mutzik


Bravo pour ce classeur musical


Dommage que je ne sois pas musicien pour l'utiliser à sa juste mesure.


Il y aurait peut-être de quoi monter un orchestre XLD :)


Petit question subsidiaire: peut-on ou pas stocker une fichier midi ou wav dans un classeur? (sans à avoir à le stocker à part sur le disque dur)
 
Dernière édition:

MichelXld

XLDnaute Barbatruc
Re : [VBA] La macro ultime (POUR CEUX QUI SAVENT LA VERITE) - Ne pas DIFFUSEZ -

bonjour à vous ... ;o

Petit question subsidiaire: peut-on ou pas stocker une fichier midi ou wav dans un classeur? (sans à avoir à le stocker à part sur le disque dur)

oui, en l'enregistrant au format binaire dans une feuille. Il me semble que Ti avait proposé une démo sur le forum. je n'ai pas retrouvé le lien mais tu peux faire une recherche sur XLD.


bon week end
michel
 

Staple1600

XLDnaute Barbatruc
Re : [VBA] La macro ultime (POUR CEUX QUI SAVENT LA VERITE) - Ne pas DIFFUSEZ -

Bonsoir MichelXld


Merci pour l'info

J'ai fais une recherche sur le forum

(Il a fallu rusé ;) )

Est-ce que tu parles de fil?
https://www.excel-downloads.com/threads/je-ne-sais-pas-combientieme-de-ti.38408/

J'ai également trouvé ce fichier dans une de tes réponses ( de 2004 )
ici

Mais il s'agit de d'un fichier Wav

En tout cas, merci pour ces infos.

Je vais regarder plus avant ce fichier.

Bon week-end à tous.
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
315 098
Messages
2 116 200
Membres
112 683
dernier inscrit
Ramo