Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Управление звуком - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Управление звуком (Макросы/Sub)
Управление звуком
Паштет Дата: Воскресенье, 25.09.2022, 13:17 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 133
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Доброго времени суток!
Решил попробовать сделать простенький частотный генератор, но уперся в несколько проблем:
1) надо подавать одну или две частоты постоянно, пока не сделаешь переключение по кнопке. Для этого я решил просто записать файл и крутить его циклично:
в модуле:
[vba]
Код
Private Declare PtrSafe Function PlaySound Lib "winmm.dll" _
        Alias "PlaySoundA" (ByVal lpszName As String, _
                    ByVal hModule As Long, ByVal dwFlags As Long) As Long
                    
Private Declare PtrSafe Function StopSound Lib "winmm.dll" _
        Alias "PlaySoundA" (ByVal lpszName As String, _
                    ByVal hModule As Long, ByVal dwFlags As Long) As Long
Sub Gh75()
Dim WAVFile As String
    Const SND_ASYNC = &H1
    Const SND_FILENAME = &H20000
    Const SND_LOOP = &H8
    WAVFile = ThisWorkbook.Path & "\75Gh.wav"
    Call PlaySound(WAVFile, 0&, SND_ASYNC Or SND_FILENAME Or SND_LOOP)
End Sub
Sub Gh75Stop()
Dim WAVFile As String
    Const SND_ASYNC = &H1
    Const SND_FILENAME = &H20000
    WAVFile = ThisWorkbook.Path & "\75Gh.wav"
       Call StopSound(WAVFile, 0&, SND_PURGE Or SND_ASYNC)
End Sub
' и далее для каждой кнопки
[/vba]
в форме для каждой кнопки:
[vba]
Код
Private Sub U75_click()
'...
If U75.Value = True Then
U125.Value = False
U175.Value = False
U225.Value = False
U275.Value = False
U325.Value = False
End If
If U75.Value = True Then Sheets(1).Cells(2, 2) = 1: Gh75 Else Sheets(1).Cells(2, 2) = 0: Gh75Stop
End Sub
[/vba]
Но проблема в том, что воспроизводится только один звук, а надо два одновременно. При отжатии кнопки (другие тоже не нажаты) все равно отыгрывается один раз звуковой файл. Хоть планирую файл сделать на 1-2 секунды, но это к сожалению тоже много.

Вторая проблема, это регулировка частоты ползунком. Я подцепил значение частоты к ячейке, где идет пересчет при изменения ползунка ScrollBar. Все здорово, но при этом на время воспроизведения макрос останавливается, пока не проиграет, а надо, чтобы работал параллельно и жутко из-за этого все тормозит. Что можно придумать?
В модуле:
[vba]
Код
Private Declare PtrSafe Function BeepAPI Lib "kernel32" _
        Alias "Beep" (ByVal FrequencyHz As Long, ByVal TimeMs As Long) As Long

Sub speedo()
a = Sheets(1).Cells(46, 2)
    BeepAPI a, 300
End Sub

[/vba]
В форме:
[vba]
Код
Private Sub ScrollBar1_Change()
With Sheets(1)
    .Cells(21, 2) = 100 - ScrollBar1.Value
    SPEEDF.Value = .Cells(21, 2)
    End With
speedo
End Sub
[/vba]
К сообщению приложен файл: primer.xlsm(32.3 Kb)


Сообщение отредактировал Паштет - Воскресенье, 25.09.2022, 15:01
 
Ответить
СообщениеДоброго времени суток!
Решил попробовать сделать простенький частотный генератор, но уперся в несколько проблем:
1) надо подавать одну или две частоты постоянно, пока не сделаешь переключение по кнопке. Для этого я решил просто записать файл и крутить его циклично:
в модуле:
[vba]
Код
Private Declare PtrSafe Function PlaySound Lib "winmm.dll" _
        Alias "PlaySoundA" (ByVal lpszName As String, _
                    ByVal hModule As Long, ByVal dwFlags As Long) As Long
                    
Private Declare PtrSafe Function StopSound Lib "winmm.dll" _
        Alias "PlaySoundA" (ByVal lpszName As String, _
                    ByVal hModule As Long, ByVal dwFlags As Long) As Long
Sub Gh75()
Dim WAVFile As String
    Const SND_ASYNC = &H1
    Const SND_FILENAME = &H20000
    Const SND_LOOP = &H8
    WAVFile = ThisWorkbook.Path & "\75Gh.wav"
    Call PlaySound(WAVFile, 0&, SND_ASYNC Or SND_FILENAME Or SND_LOOP)
End Sub
Sub Gh75Stop()
Dim WAVFile As String
    Const SND_ASYNC = &H1
    Const SND_FILENAME = &H20000
    WAVFile = ThisWorkbook.Path & "\75Gh.wav"
       Call StopSound(WAVFile, 0&, SND_PURGE Or SND_ASYNC)
End Sub
' и далее для каждой кнопки
[/vba]
в форме для каждой кнопки:
[vba]
Код
Private Sub U75_click()
'...
If U75.Value = True Then
U125.Value = False
U175.Value = False
U225.Value = False
U275.Value = False
U325.Value = False
End If
If U75.Value = True Then Sheets(1).Cells(2, 2) = 1: Gh75 Else Sheets(1).Cells(2, 2) = 0: Gh75Stop
End Sub
[/vba]
Но проблема в том, что воспроизводится только один звук, а надо два одновременно. При отжатии кнопки (другие тоже не нажаты) все равно отыгрывается один раз звуковой файл. Хоть планирую файл сделать на 1-2 секунды, но это к сожалению тоже много.

Вторая проблема, это регулировка частоты ползунком. Я подцепил значение частоты к ячейке, где идет пересчет при изменения ползунка ScrollBar. Все здорово, но при этом на время воспроизведения макрос останавливается, пока не проиграет, а надо, чтобы работал параллельно и жутко из-за этого все тормозит. Что можно придумать?
В модуле:
[vba]
Код
Private Declare PtrSafe Function BeepAPI Lib "kernel32" _
        Alias "Beep" (ByVal FrequencyHz As Long, ByVal TimeMs As Long) As Long

Sub speedo()
a = Sheets(1).Cells(46, 2)
    BeepAPI a, 300
End Sub

[/vba]
В форме:
[vba]
Код
Private Sub ScrollBar1_Change()
With Sheets(1)
    .Cells(21, 2) = 100 - ScrollBar1.Value
    SPEEDF.Value = .Cells(21, 2)
    End With
speedo
End Sub
[/vba]

Автор - Паштет
Дата добавления - 25.09.2022 в 13:17
Паштет Дата: Понедельник, 26.09.2022, 10:32 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 133
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
С ползунком поправил немного код, стало уже чуть ближе к цели, но идет пульсация, а не равномерный звук:
[vba]
Код
Sub speedo()
Do While Sheets(1).Cells(46, 2) > 0
b = 200
        b = b + 10
        DoEvents
    
a = Sheets(1).Cells(46, 2)
    BeepAPI a, b
    Loop
    
End Sub
[/vba]
 
Ответить
СообщениеС ползунком поправил немного код, стало уже чуть ближе к цели, но идет пульсация, а не равномерный звук:
[vba]
Код
Sub speedo()
Do While Sheets(1).Cells(46, 2) > 0
b = 200
        b = b + 10
        DoEvents
    
a = Sheets(1).Cells(46, 2)
    BeepAPI a, b
    Loop
    
End Sub
[/vba]

Автор - Паштет
Дата добавления - 26.09.2022 в 10:32
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Управление звуком (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2022 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!