ユーザーフォーム入門
簡易音楽プレーヤーの作成

Excelマクロのユーザーフォームの基礎、エクセルVBAの入門解説
最終更新日：2020-02-22

第25回.簡易音楽プレーヤーの作成


VBAにも音楽を！
ということでVBAで音楽再生するVBAクラスを作成しました。

VBAで音楽再生するクラスを作成
・APIの解説 ・VBAで音楽再生するクラスのVBAコード ・VBAで音楽再生するクラスの使用例 ・音楽プレーヤーを作成 ・VBAで音楽再生するクラスの最後に

そこで、このクラスを使い簡易的な音楽プレーヤーを作ってみました。
あまり本格的なものは作れませんし、良いソフトが沢山ありますので自作しても仕方ありません。


あくまで、趣味的に音楽再生ソフトを作ってみたという感じです。
ユーザーフォームの勉強の題材としては、楽しみながらできて良いかもしれません。

ユーザーフォーム

VBA マクロ 音楽再生

txtFile：最上部テキストボックス、再生中の音楽ファイルを表示
lstFile：中央のリスト、「音楽」ボタンで指定した音楽ファイルの一覧

btnFile：「音楽」ボタン、ファイルを開くダイアログ
btnDel：「削除」ボタン、一覧から削除

btnPlay：「再生」ボタン
btnNext：「次の曲」ボタン
btnPrev：「前の曲」ボタン
btnPause：「一時停止」ボタン
btnResume：「再開」ボタン
btnStop：「停止」ボタン

scrTime：横スクロールバー、任意の位置で再生
lblTime1：左下のラベル、再生ポイントの時間
lblTime2：右下のラベル、音楽の再生時間

chkRepeat：繰り返し再生、リストの最後まで再生した後に先頭から再生を繰り返す。

フォームモジュール



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の詳細については、以下を参照してください。
VBAでのタイマー処理（SetTimer,OnTime）
・Application.OnTime メソッド ・WindowsAPI:SetTimer関数 ・最後に
SetTimerで呼び出しているTimerProcは、フォームモジュールには書けないので標準モジュールにあります。

ロジックとして難しくなっているのは、
タイマーで随時監視し、スクロールバーを動かしながら、曲の最後まで行ったら次の曲に進んでいる為です。
これを、SetScrollでやっていますので、この部分が少しごちゃついています。
もう少しすっきり書けそうですが、そんなに長いプロシージャーでもないので、これで良しとしました。

※SetTimer使用時の注意

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がここに書かなければならないのは不満もありますが仕方ないところです。

VBA マクロ 音楽再生
※これはGIFで音は出していません。動作イメージだけです。

簡易音楽プレーヤーの最後に

最初にも書きましたが、音楽プレーヤーを自作しても仕方ありません。
あくまで、VBAの学習、ユーザーフォームの勉強の素材としてお使いください。
それでも実際に使ってみると、使い勝手はそんなに悪くありません。


同じテーマ「ユーザーフォーム入門」の記事

第17回.Enterキーで次のコントロールに移動する
第18回.２段階のコンボボックス
第19回.数値専用のテキストボックス
第20回.テキストボックスの各種イベント
第21回.ユーザーフォームの各種イベント
第22回.コントロールの動的作成
第23回.イベントプロシージャーの共通化
第24回.イベントプロシージャーの共通化（Enter,Exit）
第25回.簡易音楽プレーヤーの作成
第26回.プログレスバーを自作する
第27回.インクリメンタルサーチの実装


新着記事NEW ・・・新着記事一覧を見る

シート関数のCOUNTIFS,SUMIFS,MAXIFSと同じ処理｜Power Query（M言語）入門(2023-02-28)
新旧マスタの差異比較｜Power Query（M言語）入門(2023-02-28)
有効な最新単価の取得｜Power Query（M言語）入門(2023-02-26)
有効な最新単価の取得｜Power Query（M言語）入門(2023-02-21)
グルーブ内の最小・最大｜Power Query（M言語）入門(2023-02-17)
2つのテーブルのマージ｜Power Query（M言語）入門(2023-02-15)
「売上」が数値の行のみ取り込む｜Power Query（M言語）入門(2023-02-13)
A列のヘッダー名を変更する｜Power Query（M言語）入門(2023-02-11)
CSVのA列が日付の行だけを取り込む｜Power Query（M言語）入門(2023-02-10)
列数不定のCSVの取り込み｜Power Query（M言語）入門(2023-02-09)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.RangeとCellsの使い方｜VBA入門
3.変数宣言のDimとデータ型｜VBA入門
4.繰り返し処理（For Next)｜VBA入門
5.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
6.マクロって何？VBAって何？｜VBA入門
7.並べ替え（Sort）｜VBA入門
8.エクセルVBAでのシート指定方法｜VBA技術解説
9.Range以外の指定方法（Cells,Rows,Columns）｜VBA入門
10.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門



このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ
同じテーマの記事
新着記事
アクセスランク


↑