This is what I reached so far
Code: Select all
Private WithEvents wmp As WindowsMediaPlayer
Private Const SFOLDER As String = "C:\Users\Future\Desktop\Audio\"
Private Const PLAY_LIST_RANGE_ADDR = "A1:A1000"
Private Const NPLAY As Long = 2
Private Const PLAY_STATUS_RANGE_ADDR = "Z1"
Private Const PAUSE = 2
Private oCurRange As Range, rngCurrent As Range, strSilentSoundFile As String
Public Sub StartPlaying()
Call StopPlaying
Set wmp = Nothing
Set wmp = CreateObject("new:6BF52A52-394A-11D3-B153-00C04F79FAA6")
Set oCurRange = Range(PLAY_LIST_RANGE_ADDR).Cells(1)
PauseAndPlay 0
End Sub
Public Sub StopPlaying()
If Not wmp Is Nothing Then
Set oCurRange = Nothing
wmp.Close
Set wmp = Nothing
End If
Call HighLightCell(Range(PLAY_LIST_RANGE_ADDR), , False)
End Sub
Private Sub PauseAndPlay(Optional PauseSecs As Integer = PAUSE)
On Error Resume Next
Set oCurRange = GetNextMP3Cell(oCurRange)
If oCurRange = "" Then Exit Sub
Call Delay(PauseSecs)
wmp.URL = SFOLDER & oCurRange & ".mp3"
Call HighLightCell(oCurRange, 5, True)
wmp.Controls.Play
If Intersect(oCurRange.Offset(1), Range(PLAY_LIST_RANGE_ADDR)) Is Nothing Then
Application.Wait Now + TimeSerial(0, 0, PauseSecs)
Call StopPlaying
End If
Set oCurRange = oCurRange.Offset(1)
End Sub
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim strFile As String, i As Long
strSilentSoundFile = SFOLDER & "1sec.mp3"
If Len(Dir(strSilentSoundFile)) = 0 Then MsgBox strSilentSoundFile & " Is Not Found !": Exit Sub
If Not Intersect(Target, Range(PLAY_LIST_RANGE_ADDR)) Is Nothing Then
Set rngCurrent = Target
Set wmp = CreateObject("new:6BF52A52-394A-11D3-B153-00C04F79FAA6")
With wmp
For i = 1 To NPLAY
strFile = SFOLDER & rngCurrent.Value & ".mp3"
If Len(Dir(strFile)) = 0 Then MsgBox strFile & " is not found !": Exit Sub
.currentPlaylist.appendItem .newMedia(strFile)
If i < NPLAY Then .currentPlaylist.appendItem .newMedia(strSilentSoundFile)
Next i
.Controls.Play
End With
End If
Cancel = True
End Sub
Private Sub wmp_CurrentItemChange(ByVal pdispMedia As Object)
Select Case wmp.currentMedia.SourceUrl
Case strSilentSoundFile
HighLightCell rngCurrent, , False
Case Else
HighLightCell rngCurrent, 5, True
End Select
If wmp.playState = 10 Then HighLightCell rngCurrent, , False
End Sub
Private Sub HighLightCell(ByVal Cell As Range, Optional ByVal HighLightColorIndex As Long = 5, Optional Highlight As Boolean = True)
If Highlight Then
Cell.Font.Size = 26
Cell.Font.ColorIndex = HighLightColorIndex
Else
Cell.Font.Size = 13
Cell.Font.ColorIndex = 3
End If
End Sub
Private Sub Delay(ByVal HowLong As Single)
Dim t As Single
t = Timer
Do
DoEvents
Loop Until Timer - t >= HowLong
End Sub
Private Sub wmp_PlayStateChange(ByVal NewState As Long)
Dim sFeedBack As String
On Error Resume Next
Select Case NewState
Case 0: sFeedBack = "Undefined."
Case 1
sFeedBack = "Stopped."
Call HighLightCell(Range(PLAY_LIST_RANGE_ADDR), , False)
Case 2: sFeedBack = "Paused."
Case 3: sFeedBack = "Playing ..."
Case 4: sFeedBack = "ScanForward."
Case 5: sFeedBack = "ScanReverse."
Case 6: sFeedBack = "Buffering ..."
Case 7: sFeedBack = "Waiting ..."
Case 8: sFeedBack = "MediaEnded." ':
Case 9: sFeedBack = "Transitioning ..."
Case 10: sFeedBack = "Ready."
Case 11: sFeedBack = "Reconnecting ..."
End Select
Range(PLAY_STATUS_RANGE_ADDR) = sFeedBack
If NewState = 1 Then Application.OnTime Now, Me.CodeName & ".PauseAndPlay"
End Sub
Private Function GetNextMP3Cell(ByVal CurCell As Range) As Range
Dim oCell As Range, oLastCell As Range, oTempRange As Range
Set oLastCell = Range(PLAY_LIST_RANGE_ADDR).Cells(Range(PLAY_LIST_RANGE_ADDR).Cells.Count)
Set oTempRange = Range(CurCell, oLastCell)
For Each oCell In oTempRange
If Len(oCell) Then Set GetNextMP3Cell = oCell: Exit Function
Next oCell
End Function
Private Sub Workbook_Deactivate()
Call StopPlaying
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Call StopPlaying
End Sub
But when playing all the files, I encountered uncorrect behaviour as for highlighting the cells .. How can I modify the existing code so as to make only the cell that is played to be affected and after finishing it, the cell would be restored to its original state?