自作自演オルゴール装置はこんな人にオススメ！！
・midi初心者→操作が簡単！
・プログラム初心者→開発ソフトはエクセル付属のVBAだけ！例題としてもご使用いただけます！
・音階よりもリズムの耳コピ打ち込みが苦手な人
取扱説明書
シートごとに自演させたい曲の音階データを入力してください
メロディラインのデータは単音でA列に1行目から順番に入れてください。これで楽譜が自作されます
メロディラインの自演はbキーを適当なリズムで押して行ってください
データが途切れたら先頭から再び読み込みます
途中で最初から演奏させたくなったら、ホームポジション（A1セル）にアクティブセルをもっていってください
途中から自演させたい場合は、アクティブセルを自演させたいところまでもっていってください
和音のデータは3和音まで入力できます。
D,E,F列に1行目から順番に入力してください。これで楽譜が作成されます
和音の自演はvキーを適当なリズムで押して行ってください
途中で最初から演奏させたくなったら、C1セルのデータを0にするか空にしてください
途中から自演させたい場合は、C1セルの値を変えてください
データが途切れたら先頭から再び読み込みます
bキーとvキーをほぼ同時に打って和音とメロディーラインをミックスもどきさせることができます。
データの入れ方
アルファベットキーの上から1段目が黒鍵、2段目が白鍵に相当しているので、押すと音が出て、選択されたセルにデータが入力されます。
※エクセル本体を開くたびにマクロの実行が初期化されるようなので最初はキーを押しても音が出ないと思います、エクセルを開くたびに「susumu」と「susumu2」と「oto」の3つのマクロを実行すると次から音が出るようになると思います。
操作画面
以下ソースコード公開！
(昨日の日記の修正版)
エクセル立ち上げたらVisualBasicEditorを開いて、挿入→標準モジュールで貼り付けてみてね！
＝＝＝＝＝＝＝＝
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" '1オクターブ高いドのｒｙ
Application.OnKey "o", "whdore"
Application.OnKey "l", "whrere"
Application.OnKey "p", "whremi"
End Sub
Sub oto_output2() '和音出力ルーチン
s = Cells(1, 3) + 1 'アクティブセル移動方式を単音出力に使っているので、指定セル読み込み方式を使っています
a = Cells(s, 4) 'D,E,F列の3和音のデータを読み込んでいます。
b = Cells(s, 5) 'C1セルにセル指定のための番号を入力しています。
c = Cells(s, 6) '最初から演奏しなおしたいときはここを空にするか0を入れます
If a = "a" Then 'ここも、データの端につくとセル指定が先頭に戻ります
Call dodo
ElseIf a = "w" Then
Call dore
ElseIf a = "s" Then
Call rere
ElseIf a = "e" Then
Call remi
ElseIf a = "d" Then
Call mimi
ElseIf a = "f" Then
Call fafa
ElseIf a = "t" Then
Call faso
ElseIf a = "g" Then
Call soso
ElseIf a = "y" Then
Call sora
ElseIf a = "h" Then
Call rara
ElseIf a = "u" Then
Call rasi
ElseIf a = "j" Then
Call sisi
ElseIf a = "k" Then
Call hdodo
ElseIf a = "o" Then
Call hdore
ElseIf a = "l" Then
Call hrere
ElseIf a = "p" Then
Call hremi
End If
If b = "a" Then
Call dodo
ElseIf b = "w" Then
Call dore
ElseIf b = "s" Then
Call rere
ElseIf b = "e" Then
Call remi
ElseIf b = "d" Then
Call mimi
ElseIf b = "f" Then
Call fafa
ElseIf b = "t" Then
Call faso
ElseIf b = "g" Then
Call soso
ElseIf b = "y" Then
Call sora
ElseIf b = "h" Then
Call rara
ElseIf b = "u" Then
Call rasi
ElseIf b = "j" Then
Call sisi
ElseIf b = "k" Then
Call hdodo
ElseIf b = "o" Then
Call hdore
ElseIf b = "l" Then
Call hrere
ElseIf b = "p" Then
Call hremi
End If
If c = "a" Then
Call dodo
ElseIf c = "w" Then
Call dore
ElseIf c = "s" Then
Call rere
ElseIf c = "e" Then
Call remi
ElseIf c = "d" Then
Call mimi
ElseIf c = "f" Then
Call fafa
ElseIf c = "t" Then
Call faso
ElseIf c = "g" Then
Call soso
ElseIf c = "y" Then
Call sora
ElseIf c = "h" Then
Call rara
ElseIf c = "u" Then
Call rasi
ElseIf c = "j" Then
Call sisi
ElseIf c = "k" Then
Call hdodo
ElseIf c = "o" Then
Call hdore
ElseIf c = "l" Then
Call hrere
ElseIf c = "p" Then
Call hremi
End If
If Cells(s + 1, 4) = 0 Then
s = 0
End If
Cells(1, 3) = s
End Sub
Sub oto_output() '単音出力ルーチン
If ActiveCell.Value = 0 Then 'アクティブセルの位置を移動させながらデータを読み込んでいます。
Cells(1, 1).Activate 'ターミネータとして数値の0を設定しているので、データの端でアクティブセルが先頭に戻ります。
Else
n = ActiveCell.Row '単音出力はA列の先頭からデータを読みます
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 '1オクターブ高いドの音をｒｙ
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" 'bキーが押されると単音出力ルーチンへ飛びます
End Sub
Sub susumu2()
Application.OnKey "v", "oto_output2" 'vキーが押されると和音出力ルーチンへ飛びます
End Sub
＝＝＝＝＝＝＝＝
にほんブログ村
