ExcelはMP3プレイヤーと成りうるのか

音楽聞いてますか？

こんばんわ。私です。

最近の方は家で音楽を聴くとき何を使っているんでしょうか？

パソコンであれば、やっぱり"iTune"使ってる人が多いのでしょうか。私はExcelを使いたいと思います！

というわけで今回はExcelでMP3プレイヤーを作成してみましたのでご紹介です

最低限の機能すらないへっぽこです・・・

※ソースコードは最後に記述します

ボタンを３つ用意する

フォルダ選択：マクロ"FolderSerch"を割り当て

▶：マクロ"MP3player"を割り当て

■：マクロ"MP3Stopper"を割り当て

セルB1に音楽フォルダの場所、セルB5に楽曲ファイルと記載しておくと便利です

①フォルダ選択ボタンをクリック

②MP3ファイルを格納しているフォルダを選択する

人によってフォルダの場所は様々だと思いますが、私は"ミュージック"

③フォルダ指定と中身のファイルが問題なければ、セルに自動で表示される

④再生したい音楽セルをアクティブに

後は、再生ボタンで音楽を聴くことができ、停止ボタンで音楽を止めることができます

再生・停止の操作であれば比較的簡単にできますね

一時停止や再開、楽曲終了後に次ぎの楽曲へという機能は搭載できておりません

ちなみに停止する際も、停止したい楽曲を選択してる状態でないと止まりません(; ･`д･´)

それと、楽曲再生中であっても別の楽曲で再生ボタンを押すと流れ始めます

2曲同時視聴が楽しめます！

気が向いたら機能拡張していきます。サカナクションすこ( *´艸｀)

◆開発環境◆

Microsoft Excel 2019 MSO 32ビット

OS:Windows 10 Home 64bit

※以下ソース

'MP3再生のためのAPIを宣言
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

'FolderPathをモジュールレベル変数で宣言
Dim FolderPath As String

Sub MP3player() 'マクロMP3player

Dim rc As Long
'音楽フォルダのパスを取得
FolderPath = Cells(2, 2).Value
'アクティブセルのMP3ファイルと音楽フォルダのパスを結合して再生
rc = mciSendString("Play " & FolderPath & "\" & ActiveCell.Value, "", 0, 0)

End Sub 'マクロMP3playerここまで

Sub MP3Stopper() 'マクロMP3Stopper

Dim rs As Long
'音楽フォルダのパスを取得
FolderPath = Cells(2, 2).Value
'再生中のアクティブセルの音楽を止める
rs = mciSendString("Stop " & FolderPath & "\" & ActiveCell.Value, "", 0, 0)

End Sub 'マクロMP3Stopperここまで

Sub FolderSerch() 'マクロFolderSerch

Dim result As String

'Userにフォルダを選択してもらう
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
FolderPath = .SelectedItems(1)
End With

Cells(2, 2).Value = FolderPath

'エラーチェック
If Cells(2, 2) = "" Then 'セルB2が空欄なら・・・
MsgBox "フォルダが指定されていません"
Exit Sub
End If

result = Dir(FolderPath, vbDirectory) 'FolderPathが存在するか確認

If result = "" Then 'FolderPathが存在しなければ・・・
MsgBox "指定されたフォルダが存在しません"
Else
Call GetMusicFile(FolderPath) '存在すればGetMusicFileプロシージャ呼び出し(引数：FolderPath)
End If

End Sub 'マクロFolderSerchここまで

Sub GetMusicFile(Path As String) 'マクロGetMusicFile(FolderPath = Pathとして受領 )

Dim buf As String
Dim cnt As Long

cnt = 5

buf = Dir(Path & "\" & "*.mp3") 'FolderPath内の〇〇.mp3ファイルが在るか確認

If buf = "" Then '.mp3ファイルがない場合
MsgBox "MP3ファイルがフォルダに存在しません"
Exit Sub
End If

Do While buf <> "" '.mp3ファイルが在る場合、セルにあるだけ書き出す
cnt = cnt + 1
Cells(cnt, 2) = buf 'セルB6から↓に書き出していく
buf = Dir()
Loop

End Sub 'マクロGetMusicFileここまで