第25回.簡易音楽プレーヤーの作成
VBAにも音楽を!
ということでVBAで音楽再生するVBAクラスを作成しました。
そこで、このクラスを使い簡易的な音楽プレーヤーを作ってみました。
あまり本格的なものは作れませんし、良いソフトが沢山ありますので自作しても仕方ありません。
ユーザーフォームの勉強の題材としては、楽しみながらできて良いかもしれません。
ユーザーフォーム

lstFile:中央のリスト、「音楽」ボタンで指定した音楽ファイルの一覧
btnDel:「削除」ボタン、一覧から削除
btnNext:「次の曲」ボタン
btnPrev:「前の曲」ボタン
btnPause:「一時停止」ボタン
btnResume:「再開」ボタン
btnStop:「停止」ボタン
lblTime1:左下のラベル、再生ポイントの時間
lblTime2:右下のラベル、音楽の再生時間
フォームモジュール
Option Explicit
Private Declare PtrSafe Function SetTimer Lib "USER32" ( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As LongPtr) As Long
Private Declare PtrSafe Function KillTimer Lib "USER32" ( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long
Private clsSound As clsSound
Private mTimerID As Long
Private StopEvent As Boolean
Private SoundRow As Long
'フォーム初期処理
Private Sub UserForm_Initialize()
Set clsSound = New clsSound
SoundRow = 0
mTimerID = 0
StopEvent = False
Dim ctl
For Each ctl In Me.Controls
Debug.Print ctl.Name
Next
End Sub
'フォーム終了処理
Private Sub UserForm_Terminate()
On Error Resume Next
Call TimerStop
clsSound.StopSound
Set clsSound = Nothing
End Sub
'閉じるボタン
Private Sub btnClose_Click()
Unload Me
End Sub
'音楽ファイル選択
Private Sub btnFile_Click()
Dim vFile As Variant
vFile = Application.GetOpenFilename( _
FileFilter:="mp3,*.mp3,wav,*.wav", _
Title:="音楽ファイル選択", _
MultiSelect:=True)
If Not IsArray(vFile) Then Exit Sub
Dim i As Long
For i = LBound(vFile) To UBound(vFile)
Me.lstFile.AddItem vFile(i)
Next
SoundRow = 0
End Sub
'音楽ファイルを一覧から削除
Private Sub btnDel_Click()
If Me.lstFile.ListIndex < 0 Then Exit Sub
Me.lstFile.RemoveItem Me.lstFile.ListIndex
End Sub
'再生音楽表示
Private Sub txtFile_AfterUpdate()
clsSound.SoundFile = Me.txtFile.Value
Dim soundLen As Double
soundLen = clsSound.GetLength
If Not clsSound.HasOpen Then Exit Sub
Me.scrTime.Max = soundLen * 10
Me.lblTime2.Caption = timeFormat(soundLen)
Me.lblTime1.Caption = "0:0"
End Sub
'リストをクリック選択
Private Sub lstFile_Click()
SoundRow = Me.lstFile.ListIndex
Call clsSound.StopSound
Call btnPlay_Click
End Sub
'再生
Private Sub btnPlay_Click()
If SoundRow >= Me.lstFile.ListCount Then Exit Sub
Me.lstFile.ListIndex = SoundRow
Me.txtFile = Me.lstFile.List(SoundRow)
Call txtFile_AfterUpdate
clsSound.Play
If Not clsSound.HasOpen Then Exit Sub
Me.scrTime.Value = 0
If mTimerID = 0 Then TimerStart
End Sub
'一時停止
Private Sub btnPause_Click()
If Not clsSound.HasOpen Then Exit Sub
clsSound.Pause
End Sub
'再生再開
Private Sub btnResume_Click()
If Not clsSound.HasOpen Then Exit Sub
clsSound.PlayResume
End Sub
'停止
Private Sub btnStop_Click()
clsSound.StopSound
Call TimerStop
End Sub
'次の曲
Private Sub btnNext_Click()
SoundRow = SoundRow + 1
If SoundRow >= Me.lstFile.ListCount Then
SoundRow = 0
End If
Call clsSound.StopSound
Call btnPlay_Click
End Sub
'前の曲
Private Sub btnPrev_Click()
SoundRow = SoundRow - 1
If SoundRow < 0 Then
SoundRow = Me.lstFile.ListCount - 1
End If
Call clsSound.StopSound
Call btnPlay_Click
End Sub
'スクロールバーで再生位置指定
Private Sub scrTime_Change()
If Not clsSound.HasOpen Then Exit Sub
If StopEvent Then Exit Sub
clsSound.PlayPosition Me.scrTime.Value / 10
End Sub
'タイマーで再生位置指定移動
Public Sub SetScroll()
On Error Resume Next
Dim soundLen As Double
StopEvent = True
soundLen = clsSound.GetPosition
Me.scrTime.Value = soundLen * 10
Me.lblTime1.Caption = timeFormat(soundLen)
StopEvent = False
If Me.scrTime.Value >= Me.scrTime.Max - 0.1 Then
Call clsSound.StopSound
SoundRow = SoundRow + 1
If SoundRow >= Me.lstFile.ListCount Then
SoundRow = 0
If Not Me.chkRepeat.Value Then Exit Sub
End If
Call btnPlay_Click
End If
End Sub
'分:秒の表示
Private Function timeFormat(ByVal aTime As Double) As String
Dim mm As Long
mm = WorksheetFunction.RoundDown(aTime / 60, 0)
timeFormat = mm & ":" & Format(CLng(aTime - (mm * 60)), "00")
End Function
'タイマー開始
Private Sub TimerStart()
If mTimerID <> 0 Then Exit Sub
mTimerID = SetTimer(0&, 1&, 500&, AddressOf TimerProc)
End Sub
'タイマー停止
Private Sub TimerStop()
Call KillTimer(0&, mTimerID)
mTimerID = 0
End Sub
スクロールバーを音楽再生に合わせてスライドさせるために、APIのSetTimerを使っています。
SetTimerの詳細については、以下を参照してください。
タイマーで随時監視し、スクロールバーを動かしながら、曲の最後まで行ったら次の曲に進んでいる為です。
これを、SetScrollでやっていますので、この部分が少しごちゃついています。
もう少しすっきり書けそうですが、そんなに長いプロシージャーでもないので、これで良しとしました。
※SetTimer使用時の注意
KillTimerせずに終了したり、途中でVBAエラーが発生するとエクセルが落ちたり操作不能になる場合があります。
実行にあたっては十分に注意し、他のエクセルファイルは必ず閉じてから実行してください。
標準モジュールでの使用例
Option Explicit
Private frm As frmSound
Sub 音楽プレーヤー()
Set frm = New frmSound
frmSound.Show vbModeless
End Sub
Sub TimerProc()
Call frmSound.SetScroll
End Sub
Sub 強制停止()
Dim clsSound As clsSound
Set clsSound = New clsSound
clsSound.SoundFile = "音楽ファイルのフルパス"
clsSound.Play
clsSound.StopSound
End Sub
最後の強制停止は、テスト過程で音楽停止できずにフォームを閉じてしまったときに使ったものですので本筋とは無関係です。
SetTimerの呼び出しプロシージャーTimerProcがここに書かなければならないのは不満もありますが仕方ないところです。

※これはGIFで音は出していません。動作イメージだけです。
簡易音楽プレーヤーの最後に
あくまで、VBAの学習、ユーザーフォームの勉強の素材としてお使いください。
それでも実際に使ってみると、使い勝手はそんなに悪くありません。
同じテーマ「ユーザーフォーム入門」の記事
第17回.Enterキーで次のコントロールに移動する
第18回.2段階のコンボボックス
第19回.数値専用のテキストボックス
第20回.テキストボックスの各種イベント
第21回.ユーザーフォームの各種イベント
第22回.コントロールの動的作成
第23回.イベントプロシージャーの共通化
第24回.イベントプロシージャーの共通化(Enter,Exit)
第25回.簡易音楽プレーヤーの作成
第26回.プログレスバーを自作する
第27回.インクリメンタルサーチの実装
新着記事NEW ・・・新着記事一覧を見る
列全体を指定する時のRangeとColumnsの違い|ツイッター出題回答 (2023-09-24)
シートのActiveXチェックボックスの指定方法|ツイッター出題回答 (2023-09-24)
ByRef引数の型が一致しません。|ツイッター出題回答 (2023-09-22)
シートコピー後のアクティブシートは何か|ツイッター出題回答 (2023-09-19)
Excel関数の引数を省略した場合について|ツイッター出題回答 (2023-09-14)
セル個数を返すRange.CountLargeプロパティとは|VBA技術解説(2023-09-08)
記号を繰り返してグラフ作成(10単位で折り返す)|ツイッター出題回答 (2023-08-28)
シートを削除:不定数のシート名に対応|VBAサンプル集(2023-08-24)
ランクによりボイントを付ける(同順位はポイントを分割)|ツイッター出題回答 (2023-08-22)
OneDrive使用時のThisWorkbook.Pathの扱い方|VBA技術解説(2023-07-26)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.繰り返し処理(For Next)|VBA入門
4.変数宣言のDimとデータ型|VBA入門
5.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
6.マクロとは?VBAとは?VBAでできること|VBA入門
7.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
8.並べ替え(Sort)|VBA入門
9.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
10.条件分岐(IF)|VBA入門
- ホーム
- マクロVBA応用編
- ユーザーフォーム入門
- 簡易音楽プレーヤーの作成
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。