Excel VBAで新幹線・空港の音を鳴らしてみた

Excel VBAで新幹線・空港の音を鳴らしてみた
この動画のマクロはWindows11/Office2016で作成してます。

'MIDI API
Private Declare PtrSafe Function midiOutGetNumDevs Lib "winmm" () As Integer
Private Declare PtrSafe Function midiOutOpen Lib "winmm.dll" (lphMidiOut As LongPtr, ByVal uDeviceID As Long, ByVal dwCallback As LongPtr, ByVal dwInstance As LongPtr, ByVal dwflags As Long) As Long
Private Declare PtrSafe Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As LongPtr, ByVal dwMsg As Long) As Long
Private Declare PtrSafe Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As LongPtr) As Long
Dim Handle As LongPtr
'Sleep API
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
Private Declare PtrSafe Function MessageBoxTimeoutA Lib "User32.dll" (ByVal hWnd As LongPtr, ByVal lpText As String, ByVal lpCaption As String, ByVal uType As VbMsgBoxStyle, ByVal wLanguageID As Long, ByVal dwMilliseconds As Long) As Long


Sub test10()
    'データー　XXYY,ZZ,ZZ,,ZZ,,,ZZ,・・・
    '最初の項目XXYY　XX:楽器の種類00-7F   YY:1要素あたりの待ち時間（16進）
    '2以降の項目ZZ　 ZZ:真ん中のド30,ド#32,レ32,  高いド:3C     和音の場合:で区切る　ドミソ　30:34:37
    MessageBoxTimeoutA 0, "東海道新幹線", "音", 0, 65536, 1000
    Call PlayMsg("0B10,35:45,,,,,,,,3C,,,,,,,,41,,,,,,,,,3C:48,,,,,,,,45,,,,,,,,,41:46,,,,,,,,45:48,,,,,,,,,,,,,,,,,,34:46,,,,,,,,,3A,,,,,,,,3E:45,,,,,,,,,41,,,,,,,,39:40,,,,,,,,3D,,,,,,,,43,,,,,,,,,41,,,,,,,,3E,,,,,,,,,45,,,,,,,,4A,,,,,,,,45,,,,,,,,,41:4C,,,,,,,,41:4C,,,,,,,,,43:4A,,,,,,,,,45,,,,,,,,3C:46,,,,,,,,,43,,,,,,,,45:48,,,,,,,,,43,,,,,,,,,34:48,,,,,,,,3C:45,,,,,,,,40:43,,,,,,,,,45,,,,,,,,35:41,,3C,45,48,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,")

    MessageBoxTimeoutA 0, "北陸新幹線", "音", 0, 65536, 1000
    Call PlayMsg("0010,31:49,,,,,,,,44,,,,,,,38,41,,,,,44,,,,48,,,,2C:4B,,,,,,,,48,,,,,,,38:42,,,,,,,4B,,,,,,,,31:4D,,,,,,,,49,,,,,,,3B:42,,,,,,,,,,,4D,,,,,4A,,2A,4E,,,,,,,,49,,,,,,,,,36:46,,,,,,,,,,,,,42,,,,,,,,,,31,,,49,,35,38,,3D,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,")

    MessageBoxTimeoutA 0, "東北新幹線", "音", 0, 65536, 1000
    Call PlayMsg("0010,37:47,,,,,,,,,,,3E,,,,,45,,,,,43,,,,,47,,,,,48,39,,,,,,,,,,3E,,,,47,,,,,,45,,,,,48,,,,,,3B:4A,,,,48,,,,,,3E:47,,,,,4A,,,,,4F,,,,,4E,,,,,3C:4C,,,,,4A,,,,,,48,,,,47,,,,,,30:43:45,,,,,,,,,,,32:45,,,47,,,,47,,,,36,47,,45,,,47,,45,,,47,3C,,45,,,,43,,45,,,37:43,,,,,,3B,,,,,,3E,,,,,47,,,,,,,43,,,,,,4A,,,,,,,,,4F,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,")

    MessageBoxTimeoutA 0, "羽田空港", "音", 0, 65536, 1000
    Call PlayMsg("04FF,45,,42,,45,,4A,,,,,,,,,,,,,,,,")

    MessageBoxTimeoutA 0, "成田空港", "音", 0, 65536, 1000
    Call PlayMsg("0B40,43,45,48,4A,4C,4F,54,43:56,,,,,,,,,,,,,,,,,,,,,,,,")

End Sub


Public Function PlayMsg(msg_dat)
    Dim Msg As Long
    
    'MIDI出力デバイス取得
    Dim Ret As Long
    Ret = midiOutGetNumDevs

    'MIDIデバイスを開く
    If Ret = 0 Then
        Debug.Print "MIDI音源が無いため利用できません。"
        Exit Function
    End If
    Ret = midiOutOpen(Handle, -1, 0, 0, 0)
    arr_dat = Split(msg_dat, ",")
    Call midiOutShortMsg(Handle, "&H" & Mid(arr_dat(0), 1, 2) & "C0")     '
    For i = 1 To UBound(arr_dat)
        If arr_dat(i) <> "" Then
            arr_dat2 = Split(arr_dat(i), ":")
            For j = 0 To UBound(arr_dat2)
                Msg = Val("&H7F" & arr_dat2(j) & "90")
                Call midiOutShortMsg(Handle, Msg)
            Next
        End If
        Sleep ("&H" & Mid(arr_dat(0), 3, 2))
        DoEvents
    Next
    'MIDIデバイスを閉じる
    Ret = midiOutClose(Handle)
End Function