Воспроизведение звуков (проигрывание мелодий) макросом VBA

Самый простой вариант извлечь звук при помощи макроса VBA:

Shell "Cmd.exe /c echo " & Chr(7), vbHide

Эта команда вводит в консоль символ с кодом 7 (ввод этого символа вызывает звуковой сигнал)
Из спикера компьютера (не из динамиков!) прозвучит короткий однотональный звуковой сигнал.

Если же нужен звук подлиннее - то можно «ввести» в консоль несколько символов Chr(7).
Например, эта строка кода выдаст тройной звуковой сигнал:

Shell "Cmd.exe /c echo " & Chr(7) & Chr(7) & Chr(7), vbHide

Ниже приведён более сложный вариант - с использованием WinAPI (функции Beep).

Вставьте этот код в стандартный модуль:

Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
 
Sub beeps(melody As String, Optional ByVal BeepTime As Integer = 200)
    mr = "qazwsxedcrfvtgbyhnujmik,ol.p;/['"
    For i = 1 To Len(melody)
        DoEvents: nextlen = 1: letter = Mid$(melody, i, 1)
        nota = InStr(1, mr, letter)
        If IsNumeric(letter) And letter > 0 Then
            nextlen = letter: i = i + 1: nota = InStr(1, mr, Mid$(melody, i, 1))
        End If
        If nota > 0 Then
            tone = 220 * (2 ^ ((nota - 1) / 12))
            a = Beep(tone, nextlen * BeepTime)
        Else
            a = Beep(30000, nextlen * BeepTime / 5)
        End If
    Next
End Sub

Ниже создайте дополнительные функции (с заранее заданными наборами звуков):

' воспроизведение звуков высокой и низкой частоты

Sub beepH(): beeps "k", 100: End Sub
 
Sub beepH0(): beeps "k", 30: End Sub
 
Sub BeepH2(): beeps "k,k", 100: End Sub
 
Sub beepL(): Beep 100, 100: End Sub
 
Sub beepL0(): Beep 100, 30: End Sub
 
Sub BeepL2()
    Beep 100, 100
    Beep 104, 100
    Beep 100, 100
    Beep 70, 200
End Sub

Можно воспроизводить целые мелодии:

' примеры использования - воспроизведение простейших мелодий
Sub Play_Molody_1()
    speed = 150
    beeps "5 5 3jnybt tybtftdx2d", speed
    beeps "5 5 3jnybt tybtftdx2d", speed
    beeps "5 5 nnnyc3 ct2j nyc2 ty2btff ftf2t", speed
    beeps "5 5 nnnyc3 ct2j nyc2 ty2btff ftf3 yb2t", speed
End Sub
 
Sub Play_Molody_2()
    speed = 250
    beeps "jny3b3t5 5 jny3y3b 5 5 bynk2m5 bynk2m j2b2 n3y", speed
    beeps "5 5 5 jny3b3t5 5 jny3y3b 5 5 bynk2m5 bynk2m j2b2 y3t", speed
    beeps "5 5 5 ff3y5 yy2yyy2yby2b4t", speed
    beeps "5 5 5 ff2y5 tby tby nj3m", speed
End Sub

Как создавать такие мелодии?
Если вы никогда не изучали нотную грамоту - то будет сложновато.
Если повнимательнее сравнить клавиатуру компьютера и клавиатуру баяна - то можно углядеть похожее расположение клавиш.
За воспроизведение нот отвечают буквы, за паузы - пробелы.
Если перед нотой (буквой) или перед паузой (пробел) поставить цифру, длительность этой ноты (паузы) увеличивается в соответствующее количество раз)

Можете ещё побаловаться этой программкой: http://excelvba.ru/fortepiano

Вложения:

beeps.xls

29 КБ

37771 просмотр

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

саня , 11 Дек 2011 - 14:25.#1

а ты звук включи

dobroeytpo, 18 Фев 2011 - 19:20.#2

Всё чотко работает!,- я поиграл на пианине даже.

Игорь (администратор сайта), 2 Фев 2011 - 15:20.#3

А у меня не работает. XP, SP3, Off2003

Этот макрос выводит звук через спикер - динамик, расположенный внутри корпуса компьютера.
Возможно, в вашем корпусе динамик (пищалка) отсутствует, или не подключен.
Или же средствами Windows громкость звука на этом спикере убавлена до нуля.

Проверить наличие этого динамика просто - если при включении компьютера раздаётся один короткий звуковой сигнал, - значит, динамик присутствует (и работает).
Если комп включается беззвучно - открывайте корпус, и подключайте разъём спикера к материнской плате

Ed, 1 Фев 2011 - 04:36.#4

А у меня не работает. XP, SP3, Off2003 И видно, что отрабатывает, (часы крутит) и тишинаааа :)

Воспроизведение звуков (проигрывание мелодий) макросом VBA

Комментарии

Настройки просмотра комментариев

Отправить комментарий

НАДСТРОЙКИ ДЛЯ EXCEL