[VBA MIDI]VBAで成田・スキポール空港のチャイムを作ってみた/Schiphol Omroep Geluid

https://youtube.com/shorts/h5cD8F6c_cM

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　MIDIメッセージxxC0と待ち時間FFyyyy xxは0-7Fで楽器のコード。yyyyはsleepの時間
    '以降の項目ZZ　 ZZ:真ん中のド30,ド#32,レ32,  高いド:3C     和音の場合:で区切る　ドミソ　30:34:37
    'JR成田空港駅
    MessageBoxTimeoutA 0, "JR成田空港駅/JR Narita airport", "音", 0, 65536, 1000
    Call PlayMsg2("0AC0,FF0110,43,,3B:3E,43,40,,40,,42:39,,40,42,43,,32:37,,")
    '成田空港ゲート
    MessageBoxTimeoutA 0, "成田空港ゲート/Narita lobby", "音", 0, 65536, 1000
    Call PlayMsg2("04C0,FF01FF,45,42,45,4A,,,,,,")
    '成田空港搭乗口
    MessageBoxTimeoutA 0, "成田空港搭乗口/Narita gate", "音", 0, 65536, 1000
    Call PlayMsg2("0BC0,FF50,43,45,48,4A,4C,4F,54,56:43,,,,,,,,,,,,,,,,,,,,,,,,,")
    'スキポール空港
    MessageBoxTimeoutA 0, "スキポール空港/Schiphol ", "音", 0, 65536, 1000
    Call PlayMsg2("0EC0,FF0250,46,42,3D,,,,")
End Sub
Public Function PlayMsg2(msg_dat)
    Dim Msg As Long
    Dim Ret As Long
    Ret = midiOutGetNumDevs
    If Ret = 0 Then
        MessageBoxTimeoutA 0, "No MIDI", "alert", 0, 65536, 1000
    Else
        Ret = midiOutOpen(Handle, -1, 0, 0, 0)
        arr_dat = Split(msg_dat, ",")
        Call midiOutShortMsg(Handle, "&H" & Mid(arr_dat(0), 1, 2) & "C0")
        sleep_time = 50
        For i = 0 To UBound(arr_dat)
            If InStr(arr_dat(i), ":") > 0 Or Len(arr_dat(i)) <= 2 Then
                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 (sleep_time)
            Else
                If Mid(arr_dat(i), 1, 2) = "FF" Then
                    sleep_time = Val("&H" + Mid(arr_dat(i), 3))
                Else
                    Call midiOutShortMsg(Handle, "&H" & Mid(arr_dat(0), 1, 2) & "C0")
                End If
            End If
            DoEvents
        Next
        Ret = midiOutClose(Handle)
    End If
End Function