Excelでチャイムを鳴らす

VBAでチャイムを鳴らすことができる
ミニジャックを放送用の巨大ジャックにする変換ケーブルが必要。
TOAのサイトで,チャイムの音源wavDATAは入手できる。
チャイムの音源ファイルを,C:¥に入れる。
VBAのコードはつぎのとおり

ttp://excel-ubara.com/excelvba5/EXCEL104.htmlを参考にした。
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Sub 時刻で起動()
    With ThisWorkbook.ActiveSheet
        Dim i As Long
        For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            If .Cells(i, 1) <> "" And .Cells(i, 2) <> "" Then
                If .Cells(i, 2) >= Now And .Cells(i, 3) <> "済" Then
                    Range("H1").Value = Now()
                    Application.OnTime .Cells(i, 2), Procedure:="メッセージ表示"
                    Exit For
                End If
            End If
        Next
    End With
End Sub
Private Sub メッセージ表示()
    Dim i As Long, j As Long
    With ThisWorkbook.ActiveSheet
        For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            If .Cells(i, 1) <> "" And .Cells(i, 2) <> "" Then
                If .Cells(i, 2) <= Now And _
                    .Cells(i, 3) <> "済" Then
                    .Cells(i, 3) = "済"
                    narasu
                    Exit For
                End If
            End If
        Next
        Call 時刻で起動
    End With
End Sub
Sub narasu()
    Dim SoundFile As String, rc As Long
    SoundFile = "C:\chaim.wav" 
    If Dir(SoundFile) = "" Then
        MsgBox SoundFile & vbCrLf & "がありません。", vbExclamation
        Exit Sub
    End If
    rc = mciSendString("Play " & SoundFile, "", 0, 0)
End Sub

シェアする

  • このエントリーをはてなブックマークに追加

フォローする