もう1回、ExcelでWave

　以前、ExcelでWaveファイルを扱うモジュールを作りました。それを少し更新してみました。うなりの実験とかをしてみようとしたときに、使いにくかったからというのが更新理由です。

　大きな違いはAPIを使って再生している点です。init関数で初期化すれば、使えると思います。

　いろいろな正弦波を合成して、うなりとかが聞けました。物理の授業で使えそうな気がします。

　趣味のプログラムなので、動作保証はありません。悪しからず。


Option Explicit

'--------------------------------------------------
'API
'64bitの場合はコチラ
Private Declare PtrSafe Function PlaySound Lib "winmm.dll" (ByVal pszSound As String, ByVal hmod As Long, ByVal fdwSound As Long) As Long

'32bitの場合はコチラ
'Private Declare Function PlaySound Lib "winmm.dll" (ByVal pszSound As String, ByVal hmod As Long, ByVal fdwSound As Long) As Long

Private Const SND_ASYNC = &H1
'--------------------------------------------------

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

Private rChunk 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 fChunk As FMT_CHUNK

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

Private dChunk As DATA_CHUNK

Public Const SAMPLE_RATE = 44100
Public Const PI = 3.1415926535

Public Sub init()
    Dim shp As Shape
    Dim btn As Button
   
    Sheet1.Cells.Clear
   
    For Each shp In Sheet1.Shapes
        shp.Delete
    Next
   
    Set btn = Sheet1.Buttons.Add(0, 0, 80, 40)
    btn.Text = "wave write"
    btn.OnAction = "write_sample"
   
    '--------------------------------------------------
    Dim i As Long
    Dim w As Double
   
    w = 2 * PI / SAMPLE_RATE
   
    Sheet1.Cells(9, 1) = "data"
   
    For i = 0 To SAMPLE_RATE - 1
        'Sheet1.Cells(10 + i, 1) = CByte(127 + 32 * Sin(w * 1000 * i))
        Sheet1.Cells(10 + i, 1) = CByte(127 + 32 * Sin(w * 1000 * i) + 16 * Sin(w * 2000 * i) + 8 * Sin(w * 3000 * i))
        'Sheet1.Cells(10 + i, 1) = CByte(127 + 32 * Sin(w * 1000 * i) + 32 * Sin(w * 1010 * i))
    Next i
End Sub

Public Sub write_sample()
    Dim i As Long
    Dim filename As String
   
    dChunk.SubchunkSize = Sheet1.Cells(9, 1).End(xlDown).Row - 9
    ReDim dChunk.data(dChunk.SubchunkSize - 1) As Byte
   
    For i = 0 To dChunk.SubchunkSize - 1
        dChunk.data(i) = Sheet1.Cells(10 + i, 1)
    Next i
   
    '--------------------------------------------------
    filename = ThisWorkbook.Path + "\test.wav"
    writeWave filename
   
    '--------------------------------------------------
    'APIを使って再生
    PlaySound filename, 0, SND_ASYNC
End Sub

'Waveファイルの書き出し
'リニアPCM, モノラル, 44.1kHz, 8bitのみ対応
Public Sub writeWave(filename As String)
    rChunk.ChunkID = "RIFF"
    rChunk.ChunkSize = dChunk.SubchunkSize + 36
    rChunk.Format = "WAVE"
   
    fChunk.SubchunkID = "fmt "
    fChunk.SubchunkSize = 16
    fChunk.AudioFormat = 1      'リニアPCM
    fChunk.NumChannels = 1      'モノラル
    fChunk.SampleRate = SAMPLE_RATE
    fChunk.ByteRate = fChunk.SampleRate * 1
    fChunk.BlockAlign = 1
    fChunk.BitsPerSample = 8
   
    dChunk.SubchunkID = "data"
   
    Open filename For Binary As 1
        Put 1, , rChunk
        Put 1, , fChunk
        Put 1, , dChunk
    Close 1
End Sub