ExcelでWave

　Waveファイルを編集したい、ってことありますよね(?)

　Excel VBAでWaveファイルを操作するモジュールを作ってみました。適当な波形を作ってWaveファイルに保存する、みたいなことができます。

　ソースコードを以下に載せます。VBAのモジュールにコピペすれば使えるはずです。


　Waveファイルの詳細についてはWikipedia等を参照ください。

　興味ある方は、ご自由にご利用ください。(保証はありませんが orz)


2016/1/4
変数を構造体に変更しました。適当なエラー処理もいれました。気分です。


********************************************************************************

Option Explicit

'--------------------------------------------------
'Waveファイルの構造
'<RIFFChunk> + <SubChunk> + <SubChunk>
'
'SubChunkにはいくつか種類がある(fmt , data, fact, LIST)
'fmt + dataの場合にのみ対応
'fact, LISTについてはパス
'--------------------------------------------------
'<RIFFChunk>
'ChunkID        4bytes  "RIFF"
'ChunkSize      4bytes  これ以降のファイルサイズ (byte単位)
'Format         4bytes  "WAVE"
'--------------------------------------------------
'<fmt>
'SubchunkID     4bytes  "fmt ", スペースありの4文字
'SubchunkSize   4bytes  SubChunkDataのサイズ, byte単位, "fmt "なら16
'AudioFormat    2bytes  フォーマットID, リニアPCMなら1
'NumChannels    2bytes  チャンネル数, モノラルは1, ステレオは2
'SampleRate     4bytes  サンプリングレート, Hz単位, 8kHz, 44.1kHz, etc
'ByteRate       4bytes  データ速度, bytes/sec単位, 44.1kHz ステレオ, 16bitsなら176400
'BlockAlign     2bytes  ブロックサイズ, bytes/sample単位, ステレオ, 16bitsなら4
'BitsPerSample  2bytes  サンプルサイズ, bits/sample単位, WAVEフォーマットでは8bits or 16bits
'--------------------------------------------------
'<data>
'SubchunkID     4bytes  "data"
'SubchunkSize   4bytes    SubChunkDataのサイズ, byte単位
'data
'ステレオの場合、LRLR・・・の順
'8bitsなら符号なし(0～255、128が無音)
'16bitsなら符号つき (-32768～32767、0が無音)
'--------------------------------------------------

'<RIFFChunk>
Private Type RIFF_CHUNK
    ChunkID As String * 4
    ChunkSize As Long
    Format As String * 4
End Type

Private riffChunk As RIFF_CHUNK

'<fmt>
Private Type fmt_chunk
    SubchunkID As String * 4
    SubchunkSize As Long
    AudioFormat As Integer
    NumChannels As Integer
    SampleRate As Long
    ByteRate As Long
    BlockAlign As Integer
    BitsPerSample As Integer
End Type

Private fmtChunk As fmt_chunk

'<data>
Private Type DATA_CHUNK
    SubchunkID As String * 4
    SubchunkSize As Long
End Type

Private dataChunk As DATA_CHUNK


Public Const PI = 3.1415926535

Public Sub test()
    Dim i As Long
    Dim freq As Long    '正弦波の周波数, ヒトの可聴域は20Hz～20000Hzくらい
    Dim time As Double
    Dim sampling As Long
    Dim length As Long
    Dim data() As Byte
    Dim filename As String
   
    '------------------------------
    'データの作成
    freq = 1000
    time = 0.5
 
    sampling = 8000
    length = sampling * time
   
    ReDim data(length - 1) As Byte
   
    For i = 0 To length - 1
        data(i) = CByte(128 + 127 * Sin(2 * PI * freq * i / sampling))
    Next i
    '------------------------------
   
    filename = ThisWorkbook.Path + "\test.wav"
   
    'ファイルに書き出す
    writeWave filename, sampling, length, data
   
    'ファイルから読み込む
    readWave filename, sampling, length, data
End Sub



'Waveファイルの書き出し
'リニアPCM, モノラル, 8bitsのみ対応
Private Sub writeWave(filename As String, SampleRate As Long, length As Long, data() As Byte)
    riffChunk.ChunkID = "RIFF"
    riffChunk.ChunkSize = length + 36
    riffChunk.Format = "WAVE"
   
    fmtChunk.SubchunkID = "fmt "
    fmtChunk.SubchunkSize = 16
    fmtChunk.AudioFormat = 1
    fmtChunk.NumChannels = 1
    fmtChunk.SampleRate = SampleRate
    fmtChunk.ByteRate = SampleRate
    fmtChunk.BlockAlign = 1
    fmtChunk.BitsPerSample = 8
   
    dataChunk.SubchunkID = "data"
    dataChunk.SubchunkSize = length
   
    Open filename For Binary As 1
        Put 1, , riffChunk
        Put 1, , fmtChunk
        Put 1, , dataChunk
        Put 1, , data
    Close 1
End Sub

'Waveファイルの読み込み
'リニアPCM, モノラル, 8bitsのみ対応
Private Sub readWave(filename As String, ByRef SampleRate As Long, ByRef length As Long, ByRef data() As Byte)
    On Error GoTo Label1
   
    Open filename For Binary As 1
        Get 1, , riffChunk
        If riffChunk.ChunkID <> "RIFF" Then GoTo Label1
        If riffChunk.Format <> "WAVE" Then GoTo Label1
       
        Get 1, , fmtChunk
        If fmtChunk.SubchunkID <> "fmt " Then GoTo Label1
        If fmtChunk.AudioFormat <> 1 Then GoTo Label1
        If fmtChunk.NumChannels <> 1 Then GoTo Label1
        If fmtChunk.BitsPerSample <> 8 Then GoTo Label1
       
        Get 1, , dataChunk
        If dataChunk.SubchunkID <> "data" Then GoTo Label1
        '
        ReDim data(dataChunk.SubchunkSize) As Byte
        Get 1, , data
       
        SampleRate = fmtChunk.SampleRate
        length = dataChunk.SubchunkSize
    Close 1
   
    Exit Sub
   
Label1:
    Close 1
    MsgBox "error", vbExclamation
End Sub

********************************************************************************