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

Вход

Регистрация

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

 

= Мир MS Excel/Воспроизведение звука в открытой книге... - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Воспроизведение звука в открытой книге... (Формулы/Formulas)
Воспроизведение звука в открытой книге...
stalber Дата: Вторник, 26.12.2017, 21:48 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 370
Репутация: 7 ±
Замечаний: 40% ±

Excel 2021
Воспроизведение звука в открытой книге которая получает данные из закрытой книги.

Данный код что ниже написан, он работает при условии что нет надобности брать данные из закрытой книги в открытую книгу, этот код выполняет такую задачу: если в ячейки число больше 5-ти то производиться звук.

Мне нужно чтобы в открытой книге в которую импортируются данные из закрытой книги, вот в этой открытой книге производился звук если число больше 5, помогите пожалуйста доработать данный код.

Ещё раз другими словами, что мне нужно:
У меня 2 книги: книга 1 и книга 2.
Книга 1 автоматически с помощью макроса, периодически, получает данные из закрытой книги 2, каждые 30 секунд.
Книга 1 не воспроизводит звук, как сделать чтобы Книга 1 воспроизводила звук?

[vba]
Код


Dim Beep(1 To 2000 / 5) As Boolean
Private Sub Worksheet_Calculate()
    For I = 1 To UBound(Beep)
        If IsNumeric(Range("O" & I * 5)) Then
            If Range("O" & I * 5) > 5 Then
            ' или
            'If Cells(I * 5, 50) > 5 Then
                If Not Beep(I) Then BeepH2: Beep(I) = True: Exit For
            Else
                Beep(I) = False
            End If
        Else
            Beep(I) = False
        End If
    Next I
End Sub

[/vba]

[vba]
Код

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;/['"
    ' If Not UCase(VBA.Environ(5)) Like "*IGORHOME*" Then If Not GRegB("EnableSound", az_Reg_Settings) Then Exit Sub
    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))
  
       If nota > 0 Then tone = 220 * (2 ^ ((nota - 1) / 12)): a = _
       Beep(tone, nextlen * BeepTime) Else: a = Beep(30000, nextlen * BeepTime / _
5)
    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 melody1(): 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 melody2(): 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

Sub beepNew(): Beep 440, 500: End Sub

[/vba]

 
Ответить
СообщениеВоспроизведение звука в открытой книге которая получает данные из закрытой книги.

Данный код что ниже написан, он работает при условии что нет надобности брать данные из закрытой книги в открытую книгу, этот код выполняет такую задачу: если в ячейки число больше 5-ти то производиться звук.

Мне нужно чтобы в открытой книге в которую импортируются данные из закрытой книги, вот в этой открытой книге производился звук если число больше 5, помогите пожалуйста доработать данный код.

Ещё раз другими словами, что мне нужно:
У меня 2 книги: книга 1 и книга 2.
Книга 1 автоматически с помощью макроса, периодически, получает данные из закрытой книги 2, каждые 30 секунд.
Книга 1 не воспроизводит звук, как сделать чтобы Книга 1 воспроизводила звук?

[vba]
Код


Dim Beep(1 To 2000 / 5) As Boolean
Private Sub Worksheet_Calculate()
    For I = 1 To UBound(Beep)
        If IsNumeric(Range("O" & I * 5)) Then
            If Range("O" & I * 5) > 5 Then
            ' или
            'If Cells(I * 5, 50) > 5 Then
                If Not Beep(I) Then BeepH2: Beep(I) = True: Exit For
            Else
                Beep(I) = False
            End If
        Else
            Beep(I) = False
        End If
    Next I
End Sub

[/vba]

[vba]
Код

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;/['"
    ' If Not UCase(VBA.Environ(5)) Like "*IGORHOME*" Then If Not GRegB("EnableSound", az_Reg_Settings) Then Exit Sub
    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))
  
       If nota > 0 Then tone = 220 * (2 ^ ((nota - 1) / 12)): a = _
       Beep(tone, nextlen * BeepTime) Else: a = Beep(30000, nextlen * BeepTime / _
5)
    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 melody1(): 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 melody2(): 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

Sub beepNew(): Beep 440, 500: End Sub

[/vba]

Автор - stalber
Дата добавления - 26.12.2017 в 21:48
bmv98rus Дата: Вторник, 26.12.2017, 21:56 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4107
Репутация: 768 ±
Замечаний: 0% ±

Excel 2013/2016
этот код дорабатывать не нужно. У вас обновление происходит через 30 секунд, вот и надо сразу после загрузки данных запустить эту часть.
[vba]
Код
    For I = 1 To UBound(Beep)
        If IsNumeric(Range("O" & I * 5)) Then
            If Range("O" & I * 5) > 5 Then
            ' или
            'If Cells(I * 5, 50) > 5 Then
                If Not Beep(I) Then BeepH2: Beep(I) = True: Exit For
            Else
                Beep(I) = False
            End If
        Else
            Beep(I) = False
        End If
    Next I
[/vba]

Естесвенно Dim Beep(1 To 2000 / 5) As Boolean должно быть определено ранее.
Ждать калькуляции видимо смысла нет.

Вы б ссылались на прежние вопросы, ну ладно я в теме. от первого до последнего :-) , да и судя по всему вы почти все сделали, так что в работе тема становится не актуальной.

Замечательный Временно просто медведь , процентов на 20.

Сообщение отредактировал bmv98rus - Вторник, 26.12.2017, 22:36
 
Ответить
Сообщениеэтот код дорабатывать не нужно. У вас обновление происходит через 30 секунд, вот и надо сразу после загрузки данных запустить эту часть.
[vba]
Код
    For I = 1 To UBound(Beep)
        If IsNumeric(Range("O" & I * 5)) Then
            If Range("O" & I * 5) > 5 Then
            ' или
            'If Cells(I * 5, 50) > 5 Then
                If Not Beep(I) Then BeepH2: Beep(I) = True: Exit For
            Else
                Beep(I) = False
            End If
        Else
            Beep(I) = False
        End If
    Next I
[/vba]

Естесвенно Dim Beep(1 To 2000 / 5) As Boolean должно быть определено ранее.
Ждать калькуляции видимо смысла нет.

Вы б ссылались на прежние вопросы, ну ладно я в теме. от первого до последнего :-) , да и судя по всему вы почти все сделали, так что в работе тема становится не актуальной.
Автор - bmv98rus
Дата добавления - 26.12.2017 в 21:56
stalber Дата: Вторник, 26.12.2017, 23:14 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 370
Репутация: 7 ±
Замечаний: 40% ±

Excel 2021
Немного запутался, как будет правильно:

Лист1
[vba]
Код


Dim Beep(1 To 2000 / 5) As Boolean
Private Sub Worksheet_Calculate()
    For I = 1 To UBound(Beep)
        If IsNumeric(Range("O" & I * 5)) Then
            If Range("O" & I * 5) > 5 Then
            ' или
            'If Cells(I * 5, 50) > 5 Then
                If Not Beep(I) Then BeepH2: Beep(I) = True: Exit For
            Else
                Beep(I) = False
            End If
        Else
            Beep(I) = False
        End If
    Next I
End Sub

[/vba]

Модуль 1
[vba]
Код

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;/['"
    ' If Not UCase(VBA.Environ(5)) Like "*IGORHOME*" Then If Not GRegB("EnableSound", az_Reg_Settings) Then Exit Sub
    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))
  
       If nota > 0 Then tone = 220 * (2 ^ ((nota - 1) / 12)): a = _
       Beep(tone, nextlen * BeepTime) Else: a = Beep(30000, nextlen * BeepTime / _
5)
    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 melody1(): 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 melody2(): 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

Sub beepNew(): Beep 440, 500: End Sub

[/vba]

Модуль 2
[vba]
Код
Sub Get_Value_From_Close_Book()
    Application.OnTime Now + TimeSerial(0, 0, 30), "Get_Value_From_Close_Book"
    Dim sShName As String, sAddress As String, vData
    'Отключаем обновление экрана
    Application.ScreenUpdating = False
    Workbooks.Open "C:\Users\1ukom.xlsm" '"
    sAddress = "A1:O2000" 'или одна ячейка - "A1"
    'получаем значение
    vData = Sheets("Лист1").Range(sAddress).Value
    ActiveWorkbook.Close False
    'Записываем данные на активный лист книги,
    'с которой запустили макрос
    If IsArray(vData) Then
        [A1].Resize(UBound(vData, 1), UBound(vData, 2)).Value = vData
    Else
        [A1] = vData
    End If
    'Включаем обновление экрана
    Application.ScreenUpdating = True
End Sub
[/vba]
 
Ответить
СообщениеНемного запутался, как будет правильно:

Лист1
[vba]
Код


Dim Beep(1 To 2000 / 5) As Boolean
Private Sub Worksheet_Calculate()
    For I = 1 To UBound(Beep)
        If IsNumeric(Range("O" & I * 5)) Then
            If Range("O" & I * 5) > 5 Then
            ' или
            'If Cells(I * 5, 50) > 5 Then
                If Not Beep(I) Then BeepH2: Beep(I) = True: Exit For
            Else
                Beep(I) = False
            End If
        Else
            Beep(I) = False
        End If
    Next I
End Sub

[/vba]

Модуль 1
[vba]
Код

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;/['"
    ' If Not UCase(VBA.Environ(5)) Like "*IGORHOME*" Then If Not GRegB("EnableSound", az_Reg_Settings) Then Exit Sub
    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))
  
       If nota > 0 Then tone = 220 * (2 ^ ((nota - 1) / 12)): a = _
       Beep(tone, nextlen * BeepTime) Else: a = Beep(30000, nextlen * BeepTime / _
5)
    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 melody1(): 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 melody2(): 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

Sub beepNew(): Beep 440, 500: End Sub

[/vba]

Модуль 2
[vba]
Код
Sub Get_Value_From_Close_Book()
    Application.OnTime Now + TimeSerial(0, 0, 30), "Get_Value_From_Close_Book"
    Dim sShName As String, sAddress As String, vData
    'Отключаем обновление экрана
    Application.ScreenUpdating = False
    Workbooks.Open "C:\Users\1ukom.xlsm" '"
    sAddress = "A1:O2000" 'или одна ячейка - "A1"
    'получаем значение
    vData = Sheets("Лист1").Range(sAddress).Value
    ActiveWorkbook.Close False
    'Записываем данные на активный лист книги,
    'с которой запустили макрос
    If IsArray(vData) Then
        [A1].Resize(UBound(vData, 1), UBound(vData, 2)).Value = vData
    Else
        [A1] = vData
    End If
    'Включаем обновление экрана
    Application.ScreenUpdating = True
End Sub
[/vba]
Автор - stalber
Дата добавления - 26.12.2017 в 23:14
bmv98rus Дата: Среда, 27.12.2017, 00:12 | Сообщение № 4
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4107
Репутация: 768 ±
Замечаний: 0% ±

Excel 2013/2016

А в модуле листа ничего не надо.

Замечательный Временно просто медведь , процентов на 20.

Сообщение отредактировал bmv98rus - Среда, 27.12.2017, 00:12
 
Ответить
Сообщение

А в модуле листа ничего не надо.
Автор - bmv98rus
Дата добавления - 27.12.2017 в 00:12
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Воспроизведение звука в открытой книге... (Формулы/Formulas)
  • Страница 1 из 1
  • 1
Поиск:

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