Option Explicit
Public Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" _
(ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Public Declare Function Beep Lib "kernel32.dll" _
(ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
'
Sub JouerMusique(Rg As Range, DuréeNoire As Long, StylAcc As String)
Dim T As Variant, Np As Long, N As Long, Note As Long, Durée As Long, Top As Long, TopAc As Long, Tip As Long, Z As String
Dim Z3 As String, P As Long
T = Rg.Value
ChDrive "C"
ChDir "C:\Documents and Settings\luck\Mes documents\Mes sons\Acc" & StylAcc
Top = GetTickCount + DuréeNoire
Np = 1
For N = 1 To UBound(T)
Rem. T(N,1):Lgr note en unité noire, T(N,2):Octave, T(N,3):Note, T(N,4):* Liée, T(N,5):Accord éventuel
If T(N, 5) <> "" Then
Z = T(N, 5)
If InStr(Z & "+", "+") = 5 Then Z = Left$(Z, 1) & " " & Mid$(Z, 2)
If StylAcc = "Orgue" Then
P = InStr("2à53à6679", Mid$(Z, 3, 3)): If P > 0 Then Mid$(Z, 3, 3) = Mid$("MajMaj6à9", P, 3)
Z = Left$(Z, 5) 'parce qu'il n'ya qu'une seule octave
End If
Z = Z & ".wav"
TopAc = Top - 125
Do: Tip = GetTickCount: DoEvents: Loop Until Tip >= TopAc
Rg.Rows(N).Interior.Color = RGB(255, 255, 0)
If PlaySound(Z, 0, 1) = 0 Then MsgBox Z & " inexistant"
End If
Durée = Round(T(N, 1) * DuréeNoire)
Do: Tip = GetTickCount: DoEvents: Loop Until Tip >= Top
Top = Top + Durée
If T(N, 4) = "" Then Durée = Durée * 3 \ 4 'Else Durée = Durée * 15 / 16
Rg.Rows(Np).Interior.Color = RGB(65, 255, 255)
Rg.Rows(N).Interior.Color = RGB(255, 255, 0): Np = N
Z = T(N, 3): If Z <> "" Then Beep FréqNote(Z, T(N, 2)), Durée
Next N
Rg.Rows(Np).Interior.Color = RGB(65, 255, 255)
End Sub