mail mail
Главная » Макросы VBA Excel » Воспроизведение звуков (проигрывание мелодий) макросом VBA

ВНИМАНИЕ: Данная программа использует вызов системных функций - WinAPI
Поскольку синтаксис вызова этих функций в различных версиях Windows и Office может отличаться, работа программы на всех компьютерах не гарантируется!
Все размещённые на сайте макросы тестировались в Excel 2003 - 2010 под управлением 32-битной версии Windows XP

Если вы работаете в 64-битной версии Windows, или используете Office 2010 или 2013 (в котором встроена 7-я версия VBA),
то есть вероятность, что макрос работать не будет (потребуется доработка вызова функций WinAPI)
По указанным причинам, макрос не будет работать под управлением MacOS (в Excel 2004, 2008, 2011 и т.п.)

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.

Воспроизведение звуков (проигрывание мелодий) макросом 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.xls29 КБ
  • 5448 просмотров

Комментарии

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

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".
#1саня , 11 Дек 2011 - 15:25.

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

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

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

#3Ответ администратора сайта, 2 Фев 2011 - 16:20.

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

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

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

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

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

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

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
   ___    _  __    _   _  _     __  __   ____  
  / _ \  | |/ /   (_) | || |   |  \/  | / ___| 
 | | | | | ' /    | | | || |_  | |\/| | \___ \ 
 | |_| | | . \    | | |__   _| | |  | |  ___) |
  \__\_\ |_|\_\  _/ |    |_|   |_|  |_| |____/ 
                |__/
Введите код, изображенный в стиле ASCII-арт.