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

Excelマクロのユーザーフォームの基礎、エクセルVBAの入門解説
公開日:2020-02-22 最終更新日: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の学習、ユーザーフォームの勉強の素材としてお使いください。
それでも実際に使ってみると、使い勝手はそんなに悪くありません。



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

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


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

ExcelマクロVBA入門目次|エクセルの神髄(2024-03-20)
VBA10大躓きポイント(初心者が躓きやすいポイント)|VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成|ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。|エクセル雑感(2024-02-17)
初級脱出10問パック|VBA練習問題(2024-01-24)
累計を求める数式あれこれ|エクセル関数応用(2024-01-22)
複数の文字列を検索して置換するSUBSTITUTE|エクセル入門(2024-01-03)
いくつかの数式の計算中にリソース不足になりました。|エクセル雑感(2023-12-28)
VBAでクリップボードへ文字列を送信・取得する3つの方法|VBA技術解説(2023-12-07)
難しい数式とは何か?|エクセル雑感(2023-12-07)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.変数宣言のDimとデータ型|VBA入門
6.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
7.並べ替え(Sort)|VBA入門
8.条件分岐(IF)|VBA入門
9.セルのクリア(Clear,ClearContents)|VBA入門
10.マクロとは?VBAとは?VBAでできること|VBA入門




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


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



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