ランダム的な数列を「さくら」と言う音楽再生ソフトを使って再生していましたが、使っていると意外と不便な事がわかったので、どうせならエクセルでそのまま、演奏したらもっと楽しいと思い、エクセルのVBA(マクロ)で自動演奏してみました。
パソコンで音を鳴らすにはエクセルからWindowsAPIを制御してbeep音とMIDI音源を使う方法があります。Beep音は凄く簡単です。
BeepAPIを使う
Declare Function BeepAPI Lib "kernel32.dll" Alias "Beep" _(ByVal dwFreq As Long, ByVal dwDuration As Long) As LongSub Macro2()
Call BeepAPI(440, 1000)
Call BeepAPI(880, 1000)
End Sub
基本コードはBeepAPI(周波数,ms)のAPIを利用して上記のプログラムをVBAのエディターの標準モジュールにコピーして実行すればOKです。
但し、問題があって音階が切換わるごとにブチブチなって私の環境では演奏には向かない事がわかりました。
MIDI音源を使う
ネットで調べるとコードが色々載ってました。基本は「midiOutShortMsg()」APIでMIDIにデータを送って音を鳴らす方法です。色々試してみたのですが、音が出ませんでした。原因は良くわかりませんが、どうも音を出す時間が上手く設定できないため音が出ない感じでした。一つだけ音が出たソースを基にグログラムを書いてみました。
基本コードは
Declare Function midiOutOpen Lib "winmm.dll" (ByRef lphMidiOut As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOutDevice As Long, ByVal dwMsg As Long) As Long
Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOutDevice As Long) As Long
Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Sub Macro3()
Dim hDevice As Long
Call midiOutOpen(hDevice, -1, 0, 0, 0)
Call midiOutShortMsg(hDevice, 0 * 256 + 192 + 0)
Call midiOutShortMsg(hDevice, 127 * 65536 + 60 * 256 + 144 + 0)
Sleep 1000
Call midiOutClose(hDevice)
End Sub
SleepのAPIを使用したプログラムだけは音が出たので、これを基に変更して使っていますが、素人なので何処が悪くて音が出なかったかはわかりません。
最初の３行のDeclare(winmm.dll)はMIDIを使う場合に必要な宣言です。for～nextなどで演奏時間を作ってみたりしたのですが音が出ませんでした。私の場合は上手くいったのはsleep関数を使ったときだけでした。
MIDI音源のついて
今回は０～９までの数字に音階をつけるのでMIDIで使うNote番号を先ずは決めます。
ピアノ
|
周波数
|
MIDI
|
||
51
|
493.883
|
シ
|
B4
|
71
|
52
|
523.251
|
ド
|
C5
|
72
|
53
|
554.365
|
C#5
|
73
|
|
54
|
587.330
|
レ
|
D5
|
74
|
55
|
622.254
|
D#5
|
75
|
|
56
|
659.255
|
ミ
|
E5
|
76
|
57
|
698.456
|
ファ
|
F5
|
77
|
58
|
739.989
|
F#5
|
78
|
|
59
|
783.991
|
ソ
|
G5
|
79
|
60
|
830.609
|
G#5
|
80
|
|
61
|
880.000
|
ラ
|
A5
|
81
|
62
|
932.328
|
A#5
|
82
|
|
63
|
987.767
|
シ
|
B5
|
83
|
64
|
1046.502
|
ド
|
C6
|
84
|
65
|
1108.731
|
C#6
|
85
|
|
66
|
1174.659
|
レ
|
D6
|
86
|
表からわかるようにピアノの鍵盤の番号とMIDI番号では丁度「20」の差があります。この表から、例えば、ピアノの「ド」はMIDI番号の「72」で対応します。
松前 公高 リットーミュージック 2015-07-22
実際のマクロコード
ブログには直接マクロファイルは置けないので以下のコードをコピーしてエクセルの標準モジュールにコピーして実行します。
Declare Function midiOutOpen Lib "winmm.dll" (ByRef lphMidiOut As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOutDevice As Long, ByVal dwMsg As Long) As Long
Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOutDevice As Long) As Long
Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Sub AutoPiano()
'単音演奏
Dim hDevice, StrCont, Note, Tempo, i As Long
Dim StrLen As String
Const Timbre As Long = 1 '1～128 音色
Const Volume As Long = 127 '1～127
Const Channel As Long = 0 '0～15 9の場合はドラム
' Tempo = 120 'テンポ
'レイアウト
Range(Columns(3), Columns(60)).ColumnWidth = 1
Range("3:4").RowHeight = 30
For i = 0 To 16
Range(Cells(4, 3 + 3 * i), Cells(4, 5 + 3 * i)).MergeCells = True
Range(Cells(4, 3 + 3 * i), Cells(4, 5 + 3 * i)).Borders.LineStyle = xlContinuous
Next
For i = 5 To 50
Select Case i
Case 5, 11, 14, 20, 23, 26, 32, 35, 41, 44, 47
Range(Cells(3, i), Cells(3, i + 1)).Interior.Color = RGB(0, 0, 0)
End Select
Next
'数列、Tempoデータ入力
Cells(1, 1) = "入力数列"
Cells(1, 2).Select
Selection.NumberFormatLocal = "@"
Cells(1, 2) = Replace(Cells(1, 2), ".", "")
Cells(1, 2) = Replace(Cells(1, 2), " ", "")
StrLen = Len(Cells(1, 2))
If Not IsNumeric(Mid(Cells(1, 2), StrLen, 1)) Then
StrLen = StrLen - 1
End If
Cells(2, 1) = "テンポ"
If Cells(2, 2) > 30 And 230 > Cells(2, 2) Then
Else
Cells(2, 2) = 120
End If
Tempo = Cells(2, 2)
Range(Cells(1, 1), Cells(2, 2)).Font.Name = "Meiryo UI"
Call midiOutOpen(hDevice, -1, 0, 0, 0)
For i = 1 To StrLen
StrCont = Mid(Cells(1, 2), i, 1)
Select Case StrCont
Case 0 'シ
Note = 71
Case 1 'ド
Note = 72
Case 2 'レ
Note = 74
Case 3 'ミ
Note = 76
Case 4 'ファ
Note = 77
Case 5 'ソ
Note = 79
Case 6 'ラ
Note = 81
Case 7 'シ
Note = 83
Case 8 'ド
Note = 84
Case 9 'レ
Note = 86
End Select
Range(Cells(4, 3 + 3 * StrCont), Cells(4, 5 + 3 * StrCont)).Interior.Color = RGB(127, 127, 127)
Call midiOutShortMsg(hDevice, (Timbre - 1) * 256 + 192 + Channel)
Call midiOutShortMsg(hDevice, Volume * 65536 + Note * 256 + 144 + Channel)
Sleep 60000 / Tempo
If i = StrLen Then
Sleep 60000 / Tempo
End If
DoEvents
Range(Cells(4, 3), Cells(4, 54)).Interior.Color = RGB(255, 255, 255)
Next
Call midiOutClose(hDevice)
End Sub
Sub AutoPiano3()
'和音演奏
Dim hDevice, StrCont, Note, Note3, Note5, Tempo, i As Long
Dim StrLen As String
Const Timbre As Long = 1 '1～128 音色
Const Volume As Long = 127 '1～127
Const Channel As Long = 0 '0～15 9の場合はドラム
' Tempo = 120 'テンポ
'レイアウト
Range(Columns(3), Columns(60)).ColumnWidth = 1
Range("3:4").RowHeight = 30
For i = 0 To 16
Range(Cells(4, 3 + 3 * i), Cells(4, 5 + 3 * i)).MergeCells = True
Range(Cells(4, 3 + 3 * i), Cells(4, 5 + 3 * i)).Borders.LineStyle = xlContinuous
Next
For i = 5 To 50
Select Case i
Case 5, 11, 14, 20, 23, 26, 32, 35, 41, 44, 47
Range(Cells(3, i), Cells(3, i + 1)).Interior.Color = RGB(0, 0, 0)
End Select
Next
'数列、Tempoデータ入力
Cells(1, 1) = "入力数列"
Cells(1, 2).Select
Selection.NumberFormatLocal = "@"
Cells(1, 2) = Replace(Cells(1, 2), ".", "")
Cells(1, 2) = Replace(Cells(1, 2), " ", "")
StrLen = Len(Cells(1, 2))
If Not IsNumeric(Mid(Cells(1, 2), StrLen, 1)) Then
StrLen = StrLen - 1
End If
Cells(2, 1) = "テンポ"
If Cells(2, 2) > 30 And 230 > Cells(2, 2) Then
Else
Cells(2, 2) = 120
End If
Tempo = Cells(2, 2)
Range(Cells(1, 1), Cells(2, 2)).Font.Name = "Meiryo UI"
Call midiOutOpen(hDevice, -1, 0, 0, 0)
For i = 1 To StrLen
StrCont = Mid(Cells(1, 2), i, 1)
Select Case StrCont
Case 0 'シ
Note = 71
Note3 = 75
Note5 = 78
Case 1 'ド
Note = 72
Note3 = 76
Note5 = 79
Case 2 'レ
Note = 74
Note3 = 78
Note5 = 81
Case 3 'ミ
Note = 76
Note3 = 80
Note5 = 83
Case 4 'ファ
Note = 77
Note3 = 81
Note5 = 84
Case 5 'ソ
Note = 79
Note3 = 83
Note5 = 86
Case 6 'ラ
Note = 81
Note3 = 85
Note5 = 88
Case 7 'シ
Note = 83
Note3 = 87
Note5 = 90
Case 8 'ド
Note = 84
Note3 = 88
Note5 = 91
Case 9 'レ
Note = 86
Note3 = 90
Note5 = 93
End Select
Range(Cells(4, 3 + 3 * StrCont), Cells(4, 5 + 3 * StrCont)).Interior.Color = RGB(127, 127, 127)
Call midiOutShortMsg(hDevice, (Timbre - 1) * 256 + 192 + Channel)
Call midiOutShortMsg(hDevice, Volume * 65536 + Note * 256 + 144 + Channel)
Call midiOutShortMsg(hDevice, Volume * 65536 + Note3 * 256 + 144 + Channel)
Call midiOutShortMsg(hDevice, Volume * 65536 + Note5 * 256 + 144 + Channel)
Sleep 60000 / Tempo
If i = StrLen Then
Sleep 60000 / Tempo
End If
DoEvents
Range(Cells(4, 3), Cells(4, 54)).Interior.Color = RGB(255, 255, 255)
Next
Call midiOutClose(hDevice)
End Sub
Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOutDevice As Long, ByVal dwMsg As Long) As Long
Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOutDevice As Long) As Long
Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Sub AutoPiano()
'単音演奏
Dim hDevice, StrCont, Note, Tempo, i As Long
Dim StrLen As String
Const Timbre As Long = 1 '1～128 音色
Const Volume As Long = 127 '1～127
Const Channel As Long = 0 '0～15 9の場合はドラム
' Tempo = 120 'テンポ
'レイアウト
Range(Columns(3), Columns(60)).ColumnWidth = 1
Range("3:4").RowHeight = 30
For i = 0 To 16
Range(Cells(4, 3 + 3 * i), Cells(4, 5 + 3 * i)).MergeCells = True
Range(Cells(4, 3 + 3 * i), Cells(4, 5 + 3 * i)).Borders.LineStyle = xlContinuous
Next
For i = 5 To 50
Select Case i
Case 5, 11, 14, 20, 23, 26, 32, 35, 41, 44, 47
Range(Cells(3, i), Cells(3, i + 1)).Interior.Color = RGB(0, 0, 0)
End Select
Next
'数列、Tempoデータ入力
Cells(1, 1) = "入力数列"
Cells(1, 2).Select
Selection.NumberFormatLocal = "@"
Cells(1, 2) = Replace(Cells(1, 2), ".", "")
Cells(1, 2) = Replace(Cells(1, 2), " ", "")
StrLen = Len(Cells(1, 2))
If Not IsNumeric(Mid(Cells(1, 2), StrLen, 1)) Then
StrLen = StrLen - 1
End If
If Cells(2, 2) > 30 And 230 > Cells(2, 2) Then
Else
Cells(2, 2) = 120
End If
Tempo = Cells(2, 2)
Range(Cells(1, 1), Cells(2, 2)).Font.Name = "Meiryo UI"
Call midiOutOpen(hDevice, -1, 0, 0, 0)
For i = 1 To StrLen
StrCont = Mid(Cells(1, 2), i, 1)
Select Case StrCont
Case 0 'シ
Note = 71
Case 1 'ド
Note = 72
Case 2 'レ
Note = 74
Case 3 'ミ
Note = 76
Case 4 'ファ
Note = 77
Case 5 'ソ
Note = 79
Case 6 'ラ
Note = 81
Case 7 'シ
Note = 83
Case 8 'ド
Note = 84
Case 9 'レ
Note = 86
End Select
Range(Cells(4, 3 + 3 * StrCont), Cells(4, 5 + 3 * StrCont)).Interior.Color = RGB(127, 127, 127)
Call midiOutShortMsg(hDevice, (Timbre - 1) * 256 + 192 + Channel)
Call midiOutShortMsg(hDevice, Volume * 65536 + Note * 256 + 144 + Channel)
Sleep 60000 / Tempo
If i = StrLen Then
Sleep 60000 / Tempo
End If
DoEvents
Range(Cells(4, 3), Cells(4, 54)).Interior.Color = RGB(255, 255, 255)
Next
Call midiOutClose(hDevice)
End Sub
Sub AutoPiano3()
'和音演奏
Dim hDevice, StrCont, Note, Note3, Note5, Tempo, i As Long
Dim StrLen As String
Const Timbre As Long = 1 '1～128 音色
Const Volume As Long = 127 '1～127
Const Channel As Long = 0 '0～15 9の場合はドラム
' Tempo = 120 'テンポ
'レイアウト
Range(Columns(3), Columns(60)).ColumnWidth = 1
Range("3:4").RowHeight = 30
For i = 0 To 16
Range(Cells(4, 3 + 3 * i), Cells(4, 5 + 3 * i)).MergeCells = True
Range(Cells(4, 3 + 3 * i), Cells(4, 5 + 3 * i)).Borders.LineStyle = xlContinuous
Next
For i = 5 To 50
Select Case i
Case 5, 11, 14, 20, 23, 26, 32, 35, 41, 44, 47
Range(Cells(3, i), Cells(3, i + 1)).Interior.Color = RGB(0, 0, 0)
End Select
Next
'数列、Tempoデータ入力
Cells(1, 1) = "入力数列"
Cells(1, 2).Select
Selection.NumberFormatLocal = "@"
Cells(1, 2) = Replace(Cells(1, 2), ".", "")
Cells(1, 2) = Replace(Cells(1, 2), " ", "")
StrLen = Len(Cells(1, 2))
If Not IsNumeric(Mid(Cells(1, 2), StrLen, 1)) Then
StrLen = StrLen - 1
End If
If Cells(2, 2) > 30 And 230 > Cells(2, 2) Then
Else
Cells(2, 2) = 120
End If
Tempo = Cells(2, 2)
Range(Cells(1, 1), Cells(2, 2)).Font.Name = "Meiryo UI"
Call midiOutOpen(hDevice, -1, 0, 0, 0)
For i = 1 To StrLen
StrCont = Mid(Cells(1, 2), i, 1)
Select Case StrCont
Case 0 'シ
Note = 71
Note3 = 75
Note5 = 78
Case 1 'ド
Note = 72
Note3 = 76
Note5 = 79
Case 2 'レ
Note = 74
Note3 = 78
Note5 = 81
Case 3 'ミ
Note = 76
Note3 = 80
Note5 = 83
Case 4 'ファ
Note = 77
Note3 = 81
Note5 = 84
Case 5 'ソ
Note = 79
Note3 = 83
Note5 = 86
Case 6 'ラ
Note = 81
Note3 = 85
Note5 = 88
Case 7 'シ
Note = 83
Note3 = 87
Note5 = 90
Case 8 'ド
Note = 84
Note3 = 88
Note5 = 91
Case 9 'レ
Note = 86
Note3 = 90
Note5 = 93
End Select
Range(Cells(4, 3 + 3 * StrCont), Cells(4, 5 + 3 * StrCont)).Interior.Color = RGB(127, 127, 127)
Call midiOutShortMsg(hDevice, (Timbre - 1) * 256 + 192 + Channel)
Call midiOutShortMsg(hDevice, Volume * 65536 + Note * 256 + 144 + Channel)
Call midiOutShortMsg(hDevice, Volume * 65536 + Note3 * 256 + 144 + Channel)
Call midiOutShortMsg(hDevice, Volume * 65536 + Note5 * 256 + 144 + Channel)
Sleep 60000 / Tempo
If i = StrLen Then
Sleep 60000 / Tempo
End If
DoEvents
Range(Cells(4, 3), Cells(4, 54)).Interior.Color = RGB(255, 255, 255)
Next
Call midiOutClose(hDevice)
End Sub
使い方は最初に一度だけマクロ「AutoPiano()」か「AutoPiano3()」を実行してから、セル「B1]に数列を入力してください。小数点と半角スペースはマクロ動作時に自動的に省かれます。テンポは最初は「120」で演奏されていますが変更可能です。
その後、再度実行すると演奏が始まります。マクロをボタンなどの図形に登録しておくと簡単に演奏を試せます。
単音演奏用マクロ→AutoPiano()
和音演奏用マクロ→AutoPiano3()
入力の数列は一度、文字データに変換しています。エクセルは桁数が多い数列を入れると自動的に指数表示に変換されてしまうので数列を文字として扱っています。
音階にあわせて鍵盤の色が変ります。しかし、たまにMIDIは外部制御なので問題ないですが、作画が間に合わなくなって書き換えができなくなる事があります。なのでDoEvents関数を入れることにより一度OSに制御を戻すことで正常に動作するようにしています。
ピアノの鍵盤は半音も表示していますが、演奏に追従する鍵盤は根音(ルート)の鍵盤だけです。黒い鍵盤は飾りになってます。時間があれば和音にも対応したいのですが．．．
当初の目的の自動演奏はできたので良かったのですが、ネット情報だけでは環境が違うので上手く動かない事が多いと言う事がわかりました。
折角、マクロを作ったので「＞＞」にマクロVBAの詳細説明をまとめておきます。興味がある方は見てください。
