LoginSignup
3
4

More than 5 years have passed since last update.

VBA API 64/32bit共用 音を鳴らす

Last updated at Posted at 2018-08-19
Option Explicit
#If VBA7 Then
'Wavファイルを鳴らすmcSendString
Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As LongPtr) As Long
'Beep音を鳴らす
Declare PtrSafe Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
#Else
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

Declare Function Beep Lib "kernel32" Alias "Beep" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
#End If
'MessageBeep
'https://msdn.microsoft.com/ja-jp/library/cc429002.aspx?f=255&MSPPError=-2147217396
'戻り値
'関数が成功すると、0 以外の値が返ります。
'関数が失敗すると、0 が返ります。拡張エラー情報を取得するには、GetLastError 関数を使います。
'解説
'MessageBeep 関数は、サウンドをキューに置いた後、呼び出し側へ制御を返し、非同期的にサウンドを再生します。
'指定された警告音を再生できない場合、MessageBeep 関数は一般の警告音を再生しようとします。一般の警告音を再生できない場合、コンピュータのスピーカから発生する標準的なビープ音を鳴らします。
'ユーザーは、コントロールパネルの[サウンド]を使って、警告のビープオンを無効にできます。
#If VBA7 Then
Declare PtrSafe Function MessageBeep Lib "user32" (ByVal wType As Long) As Long
#Else
#If Win32 Then
    Declare Sub MessageBeep Lib "User32" (ByVal N As Long)
#Else
    Declare Sub MessageBeep Lib "User" (ByVal N As Integer)
#End If
#End If
'http://www.vb-zentrum.de/tip_api.html
Public Enum BeepType
  MB_ICONASTERISK = &H1& '情報
  MB_ICONEXCLAMATION = &H30& '警告
  MB_ICONQUESTION = &H20& '問合せ
  MB_ICONHAND = &H10& 'システムエラー
  MB_OK = &H0 '一般の警告音
  MB_SPEEKER = -1
End Enum

Sub PlaySoundFileTest1()
'http://officetanaka.net/excel/vba/tips/tips22.htm
    Dim SoundFile As String, rc
    'ただしWindows10ではMediaフォルダやWavファイルが管理者によって削除されている場合がある
    SoundFile = "C:\Windows\media\Ring01.wav" '"C:\Windows\Media\tada.wav"
    If Dir(SoundFile) = "" Then
        MsgBox SoundFile & vbCrLf & "がありません。", vbExclamation
        Exit Sub
    End If
    rc = mciSendString("Play " & SoundFile & " wait", "", 0, 0)
End Sub

Sub PlaySoundFileTest2()
'http://officetanaka.net/excel/vba/tips/tips22.htm
    Dim SoundFile As String, rc
    'ただしWindows10ではMediaフォルダやWavファイルが管理者によって削除されている場合がある
    SoundFile = "C:\Windows\media\Ring01.wav" '"C:\Windows\Media\tada.wav"
    If Dir(SoundFile) = "" Then
        MsgBox SoundFile & vbCrLf & "がありません。", vbExclamation
        Exit Sub
    End If
    rc = mciSendString("Open " & SoundFile, "", 0, 0)
    rc = mciSendString("Play " & SoundFile & " wait", "", 0, 0)
    rc = mciSendString("Close " & SoundFile, "", 0, 0)
    SoundFile = "C:\Windows\Media\tada.wav"
    If Dir(SoundFile) = "" Then
        MsgBox SoundFile & vbCrLf & "がありません。", vbExclamation
        Exit Sub
    End If
    rc = mciSendString("Open " & SoundFile, "", 0, 0)
    rc = mciSendString("Play " & SoundFile & " wait", "", 0, 0)
    rc = mciSendString("Close " & SoundFile, "", 0, 0)
End Sub

Public Function fnBeep(lngHelz as Long,lngDurationMilliSeconds As Long)
Beep lngHelz,lngDurationMilliseconds
End function
Sub BeepSoundTest()
Dim HeltzLong As Long
Dim JikanLong As Long 'millisecond
HeltzLong = 440
JikanLong = 1000 '1 Second
Beep HeltzLong, JikanLong
End Sub
Sub MessageBeepTest()
Dim Result
Result = 0
'Windows10は標準だと同じ音が設定されているためがないのでこの2種類が顕著な違いがある。
' Stopで止めないと音が鳴らない
Result = MessageBeep(BeepType.MB_ICONEXCLAMATION)
Stop
MessageBeep BeepType.MB_ICONHAND
'どちらの書き方でもよい
End Sub

各関数

mcSendString

wavファイル名を送信して音を鳴らす
ただしこのC:\Windows\Mediaのファイルは管理者によって削られている場合がある。
削られていない場合はtada.wavがあるが昔と比べると安っぽい。
また一つならしたら時間をおかないと次のが鳴る。
OfficeTanaka 大先生のを改造しているが、呼び出すときが重い。

Beep

確実に使える。ただし音の高さと時間しかないのでサイン波(だと思う)が出る。
最大同時発音数は1なので、和音を鳴らすことはできない。
15000以上にするとモスキート音が出せるので加齢チェックに使える。
しかしなぜかノイズが出る
なので普通は1000程度を1秒(1000)鳴らすとかそういう使い方をする
fnBeep関数を作ったのでDeclare Beepと組でこれで任意の高さの音を鳴らせる。

MessageBeep

Windows10のシステム音が鳴らせる。
システム音を変えると音が変わる。
しかしシステム音がしょぼいので、2種類しか出ない。
Enumにするのは上記リンク先掲示板のアイディアだが、実質2種類しかない。

3
4
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
3
4