Musica in Excel

Hai un problema con Excel?

Nuova discussione

Musica in Excel
di Carl (utente non iscritto) data: 07/05/2017 03:28:40
Ciao, vorrei realizzare un sequencer midi in Excel e vba, (non chiedetemi perchè...) Ho trovato questo sito che dice come farlo:

Ho provato, soltanto che non emette suono. Il codice non da errori. Dispongo del file winmm.dll in System32, ma in excel la Sub "PlayMIDI" non appare nell'elenco delle Sub da assegnare al pulsante, mi dà solo la Sub "TestMidi". Quando eseguo la Sub si sente solo un fruscio (prova che qualcosa funziona) che dura di più o di meno a seconda del numero di celle che inserisco, però nessun suono...forse sbaglio a inserire i dati nelle celle (inserisco 1,0,1000 corrispettivamente strumento, nota, durata), forse qualcosa di sbagliato nel codice? O forse è una questione solo di audio...sapreste aiutarmi? Grazie

Option Explicit
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
 
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
 
 
**********************************************

The PlayMIDI Sub procedure accepts three arguments, and plays a single note. The argument are:
•	voiceNum: A number from 1-128 that represents the instrument sound. Here’s a list of the MIDI voice numbers.
•	noteNum: A number that indicates the note to play. For reference, C is 0, 12, 24, 36, etc. C# is 1, 13, 25, 37, etc.
•	Duration: A number that indicates how long to play the note, in milliseconds (1,000 equals 1 second).
To play around with this, I set up a worksheet that has a 4-column list of notes. A lookup table provides the actual note letters for the values in column B. In the figure, I have it set up to generate random notes and durations. Then, a simple macro plays the song.

Then, a simple macro plays the song represented by the worksheet data.

****************************************


Sub TestMidi()
    Dim r As Long
    ActiveSheet.Calculate
    For r = 2 To Application.CountA(Range("A:A"))
        Call PlayMIDI(Cells(r, 1), Cells(r, 2), Cells(r, 3))
    Next r
 End Sub

di patel data: 07/05/2017 09:07:32
anche a me fa solo rumore, da quale sito hai copiato il codice ? non mettere h t t p
di Carl (utente non iscritto) data: 07/05/2017 09:29:02
Ciao, grazie per la risposta...

dailydoseofexcel.com/archives/2007/02/06/musical-excel/

Non offre supporto ed è di 10 anni fa...Forse c'entra qualcosa la lib kernel32 (che magari bisogna installare), ma non so cosa sia...
di Carl (utente non iscritto) data: 07/05/2017 09:37:03
...per il file midi da suonare non metto un file, metto un numero, come indica nel sito...1 dovrebbe essere il piano.

di patel data: 07/05/2017 10:19:59
prova così, la riga 1 non deve essere vuota

#If Win64 Then
    Declare PtrSafe Function midiOutOpen Lib "winmm.dll" (lphMidiOut As LongPtr, ByVal uDeviceID As Long, ByVal dwCallback As LongPtr, ByVal dwInstance As LongPtr, ByVal dwFlags As Long) As Long
    Declare PtrSafe Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As LongPtr) As Long
    Declare PtrSafe Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As LongPtr, ByVal dwMsg As Long) As Long
#Else
    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
#End If

#If Win64 Then
    Private hMidiOut1 As LongLong
#Else
    Private hMidiOut1 As Long
#End If
 
Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Dim hMidiOut As Long
Public lanote As Long
 
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 TestMidi()
    Dim r As Long
    ActiveSheet.Calculate
    For r = 2 To Application.CountA(Range("A:A"))
        Call PlayMIDI(Cells(r, 1), Cells(r, 2), Cells(r, 3))
    Next r
 End Sub

di Carl (utente non iscritto) data: 07/05/2017 10:43:10
non va...ancora solo fruscìo. Ma cosa hai inserito nelle celle? tipo 1,0,1000? Ti lascio la mia mail, se vuoi puoi mandarmi allegati: bearbull1990@gmail.com

Grazie
di patel data: 07/05/2017 11:31:13
allego il file

Vuoi Approfondire?