Управление звуком

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Управление звуком (Макросы/Sub)

Управление звуком

Паштет

Дата: Воскресенье, 25.09.2022, 13:17 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 159

Репутация: 7 ±

Замечаний: 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]

Код

[/vba]
в форме для каждой кнопки:
[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]

Код

[/vba]
в форме для каждой кнопки:
[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

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 159

Репутация: 7 ±

Замечаний: 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]

Ответить

Управление звуком (Макросы/Sub)

Страница 1 из 1
1