Repeat code in double-click event

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Repeat code in double-click event

Post by YasserKhalil »

Hello everyone
I have a code but I will not be able to post the entire code as the owner of the code told me not to publish it (Sorry for that)
The code is working from ThisWorkbook module

Code: Select all

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range(PLAY_LIST_RANGE_ADDR)) Is Nothing Then
        Dim i As Long
        For i = 1 To 2
            Call StopPlaying
            Set wmp = Nothing
            Set wmp = CreateObject("new:6BF52A52-394A-11D3-B153-00C04F79FAA6")
            wmp.URL = SFOLDER & Target & ".mp3"
            Call HighLightCell(Target, 5, True)
            wmp.Controls.Play
            Application.Wait Now + TimeValue("00:00:03")
        Next i
        Cancel = True
    End If
End Sub
It is supposed to play mp3 file when double click in the cell. It is working well with no problem
What I am trying to modify is to make the mp3 file repeated twice ( I mean to run this event twice instead of once)
I tried to declare a variable i and to make a loop of 2 iterations and also added line of waiting, but when double click the cell, the file is played once not twice. Any idea how to make it repeat for twice?

Posted here too
https://www.excelforum.com/excel-progra ... ost5397917

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Repeat code in double-click event

Post by YasserKhalil »

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?