忍者ブログ
20080511~ 13と7と11の倍数の論理積は13と7と11の積の倍数である。 和ァ・・・
[525] [524] [523] [522] [521] [520] [519] [518] [517] [516] [515]


自作自演オルゴール装置はこんな人にオススメ!!
・midi初心者→操作が簡単!
・プログラム初心者→開発ソフトはエクセル付属のVBAだけ!例題としてもご使用いただけます!
・音階よりもリズムの耳コピ打ち込みが苦手な人


取扱説明書
4642894d.JPG










シートごとに自演させたい曲の音階データを入力してください
 

メロディラインのデータは単音でA列に1行目から順番に入れてください。これで楽譜が自作されます
メロディラインの自演はbキーを適当なリズムで押して行ってください
データが途切れたら先頭から再び読み込みます
途中で最初から演奏させたくなったら、ホームポジション(A1セル)にアクティブセルをもっていってください
途中から自演させたい場合は、アクティブセルを自演させたいところまでもっていってください

和音のデータは3和音まで入力できます。
D,E,F列に1行目から順番に入力してください。これで楽譜が作成されます
和音の自演はvキーを適当なリズムで押して行ってください
途中で最初から演奏させたくなったら、C1セルのデータを0にするか空にしてください
途中から自演させたい場合は、C1セルの値を変えてください
データが途切れたら先頭から再び読み込みます

bキーとvキーをほぼ同時に打って和音とメロディーラインをミックスもどきさせることができます。

データの入れ方
アルファベットキーの上から1段目が黒鍵、2段目が白鍵に相当しているので、押すと音が出て、選択されたセルにデータが入力されます。

※エクセル本体を開くたびにマクロの実行が初期化されるようなので最初はキーを押しても音が出ないと思います、エクセルを開くたびに「susumu」と「susumu2」と「oto」の3つのマクロを実行すると次から音が出るようになると思います。





操作画面
58dd79e6.JPG








以下ソースコード公開!
(昨日の日記の修正版)
エクセル立ち上げたら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"  'ド#の音をry
    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オクターブ高いドのry
    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    'ド#の音を出力するルーチンをry
        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オクターブ高いドの音をry
        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
========






にほんブログ村 科学ブログ 自然科学へ
にほんブログ村

拍手[4回]

PR

コメント


コメントフォーム
お名前
タイトル
文字色
メールアドレス
URL
コメント
パスワード
  Vodafone絵文字 i-mode絵文字 Ezweb絵文字


トラックバック
この記事にトラックバックする:


忍者ブログ [PR]
カレンダー
06 2017/07 08
S M T W T F S
21 22
23 24 25 26 27 28 29
30 31
ブログランキング
ブログランキング参戦中
にほんブログ村 アニメブログ 深夜アニメへ
にほんブログ村 漫画ブログ SF・ファンタジー漫画へ
にほんブログ村 科学ブログ 自然科学へ
よかったらポチッとお願いします^^
最新CM
[12/01 量子きのこ]
[11/06 NONAME]
[10/12 量子きのこ]
[10/11 にしもり]
[10/05 量子きのこ]
プロフィール
HN:
量子きのこ
年齢:
36
性別:
男性
誕生日:
1981/04/04
職業:
WinDOS.N臣T
趣味:
妄想・計算・測定・アニメ
自己紹介:
日記タイトルの頭についてるアルファベットは日記の番号です
26進数を右から読みます
例:H→7番目、XP→15(P)×26+23(X)=413番目。
A=0とする仕様につき一番右の桁はAにできませんのでご了承くださいズコー
バーコード
ブログ内検索
アクセス解析