YS：念願の半自動演奏装置 試作版完成

以前の日記で、音程を自動、リズムを手動で演奏できる、自動演奏と手動演奏の中間みたいな装置があればいいなっていう話をしていたと思います。

そのときはICを使った電子工作からのアプローチで作ろうとしていたのですが、モノが少なくとも3000円はするらしいということで、収入源のない僕としてはこのような大金を使うわけにはいかなかったのです。

かといってプログラミングとは縁を切りたいし、なにより開発環境を入れたくないからどうにもできないと思っていた矢先でした。

昨晩布団の中で寝付けないでいると、ふと思い当たることがあったのです。
エクセルのマクロがあるじゃないか。
エクセルのマクロならエクセルがPCに入っていればいつでも使えるし、作れる。

そういうことならマクロにだけは手を出すスタンスで行っても悪くはないかなとも思えてきたのです。

それで出来上がったのがこれです。
自動演奏風景をアップしてみました。

今回はニコ動へのアップにも手を出してみました。

キーボードのbボタンを押すごとに音が変わります。
鳴らす音階はエクセルファイルのA列に順番にデータとして入っていますが、鳴らすタイミングはbキーの押すタイミングなので演奏者の自由です。

A列に書いてある文字は、音階の楽譜です。

ローマ字入力のアルファベット3段のうち、上1段を黒鍵、中1段を白鍵として使っています。
なので、
A：ド
W：ド＃
S：レ
E：レ＃
D：ミ
F：ファ
T：ファ＃
G：ソ
Y：ソ＃
H：ラ
U：ラ＃
J：シ
K：高いド
O：高いド＃
L：高いレ
P：高いレ＃

の音に対応しています。

キーボード鍵盤を直接押して演奏することも可能ですが、
通常はA列のセル1つ1つに順番に音階のデータを入力してから、
「b」キーで半自動演奏させることを推奨しています。

開発費はタダだと思います。3000円以上浮きました。
(オフィスソフト・PCなどの減価償却は考慮しません)

 

＝＝＝＝＝
この辺から内輪ネタです。

しょうもないプログラムなので、マクロのソースを公開します。
使ってみたい人がもしいたらコピペでもしてください(笑)
エクセルの新規ファイルを開いて、VisualBasicEditorボタンを押すと、VisualBasic言語の開発画面に移るので、そこで挿入→標準モジュールを選んでコピーした文字を貼り付けるとマクロが登録されます。

音階データはどのシートのA列に入力しても動作します。
アクティブなシートを認識するようです。

音階データのターミネータは数値の0としたので、データが途切れて空のデータにアクティブセルがたどり着くと、アクティブセルがホームポジションに戻ります。

関数や変数なんかの名前に難があるので、見た人はよくわからないかもしれません。コメントもありません。(笑)
ノートの板書・落書き・チラシの裏レベルです。

 

予定としては、和音もどきの半自動演奏にも手を出したいと思っています。

音はビープ音を使用していて、ビープ音は重複発音や音量調整ができないので、
とりあえず命令をずらして和音っぽくしようかなとか思ってます(笑)

ビープ音はAPIだったかを使うため、プログラムの先頭にC言語で言うinclude文みたいなおまじないをつけておくようです。

 

＝＝＝＝＝＝＝＝＝
Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Sub dodo()
    Call Beep(262, 50)
End Sub
Sub dore()
    Call Beep(277, 50)
End Sub
Sub rere()
    Call Beep(293, 50)
End Sub
Sub remi()
    Call Beep(311, 50)
End Sub
Sub mimi()
    Call Beep(330, 50)
End Sub
Sub fafa()
    Call Beep(349, 50)
End Sub
Sub faso()
    Call Beep(370, 50)
End Sub
Sub soso()
    Call Beep(392, 50)
End Sub
Sub sora()
    Call Beep(415, 50)
End Sub
Sub rara()
    Call Beep(440, 50)
End Sub
Sub rasi()
    Call Beep(466, 50)
End Sub
Sub sisi()
    Call Beep(494, 50)
End Sub
Sub hdodo()
    Call Beep(523, 50)
End Sub
Sub hdore()
    Call Beep(554, 50)
End Sub
Sub hrere()
    Call Beep(587, 50)
End Sub
Sub hremi()
    Call Beep(622, 50)
End Sub

Sub wdodo()
    Call Beep(262, 50)
    ActiveCell.Value = "a"
End Sub
Sub wdore()
    Call Beep(277, 50)
    ActiveCell.Value = "w"
End Sub
Sub wrere()
    Call Beep(293, 50)
    ActiveCell.Value = "s"
End Sub
Sub wremi()
    Call Beep(311, 50)
    ActiveCell.Value = "e"
End Sub
Sub wmimi()
    Call Beep(330, 50)
    ActiveCell.Value = "d"
End Sub
Sub wfafa()
    Call Beep(349, 50)
    ActiveCell.Value = "f"
End Sub
Sub wfaso()
    Call Beep(370, 50)
    ActiveCell.Value = "t"
End Sub
Sub wsoso()
    Call Beep(392, 50)
    ActiveCell.Value = "g"
End Sub
Sub wsora()
    Call Beep(415, 50)
    ActiveCell.Value = "y"
End Sub
Sub wrara()
    Call Beep(440, 50)
    ActiveCell.Value = "h"
End Sub
Sub wrasi()
    Call Beep(466, 50)
    ActiveCell.Value = "u"
End Sub
Sub wsisi()
    Call Beep(494, 50)
    ActiveCell.Value = "j"
End Sub
Sub whdodo()
    Call Beep(523, 50)
    ActiveCell.Value = "k"
End Sub
Sub whdore()
    Call Beep(554, 50)
    ActiveCell.Value = "o"
End Sub
Sub whrere()
    Call Beep(587, 50)
    ActiveCell.Value = "l"
End Sub
Sub whremi()
    Call Beep(622, 50)
    ActiveCell.Value = "p"
End Sub

Sub oto()
    Application.OnKey "a", "wdodo"
    Application.OnKey "w", "wdore"
    Application.OnKey "s", "wrere"
    Application.OnKey "e", "wremi"
    Application.OnKey "d", "wmimi"
    Application.OnKey "f", "wfafa"
    Application.OnKey "t", "wfaso"
    Application.OnKey "g", "wsoso"
    Application.OnKey "y", "wsora"
    Application.OnKey "h", "wrara"
    Application.OnKey "u", "wrasi"
    Application.OnKey "j", "wsisi"
    Application.OnKey "k", "whdodo"
    Application.OnKey "o", "whdore"
    Application.OnKey "l", "whrere"
    Application.OnKey "p", "whremi"
End Sub
Sub oto_output()
If ActiveCell.Value = 0 Then
Cells(1, 1).Activate
Else
    n = ActiveCell.Row
    s = ActiveCell.Value
    If s = "a" Then
        Call dodo
    ElseIf s = "w" Then
        Call dore
    ElseIf s = "s" Then
        Call rere
    ElseIf s = "e" Then
        Call remi
    ElseIf s = "d" Then
        Call mimi
    ElseIf s = "f" Then
        Call fafa
    ElseIf s = "t" Then
        Call faso
    ElseIf s = "g" Then
        Call soso
    ElseIf s = "y" Then
        Call sora
    ElseIf s = "h" Then
        Call rara
    ElseIf s = "u" Then
        Call rasi
    ElseIf s = "j" Then
        Call sisi
    ElseIf s = "k" Then
        Call hdodo
    ElseIf s = "o" Then
        Call hdore
    ElseIf s = "l" Then
        Call hrere
    ElseIf s = "p" Then
        Call hremi
    End If
    End If
    Cells(n + 1, 1).Activate
End Sub
Sub susumu()
    Application.OnKey "b", "oto_output"
End Sub

＝＝＝＝＝＝＝＝


にほんブログ村


にほんブログ村