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
********************************************************************************
'--------------------------------------------------
'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
********************************************************************************
0 件のコメント:
コメントを投稿