12
返回列表 上一主題 發帖

[發問] WindowsMediaPlayer播放音檔問題

lshsien

帖子
6 
主題
2 
精華
0 
積分
37 
點名
0  
作業系統
win7 
軟體版本
office2010 
閱讀權限
10 
性別
男 
註冊時間
2014-4-15 
最後登錄
2019-1-15 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2016-1-19 20:55 | 只看該作者

[發問] WindowsMediaPlayer播放音檔問題

請問各位大大，小弟使用vba WindowsMediaPlayer撥放音檔，
分別加入14個音檔list後，卻無法一次播完，平均每4個音檔會停止撥放，
在煩請大大解惑謝謝！
程式碼如下
Public Sub macro_test2()

Dim Bk_A As String
Bk_A = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5)
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Dim book_name As String
Dim book_path As String

book_name = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5)
book_path = ThisWorkbook.Path

工作表001.WindowsMediaPlayer1.currentPlaylist.Clear

music_path01 = ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_各位旅客您好" & ".wav"
music_path02 = ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_6點" & ".wav"
music_path03 = ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_分50" & ".wav"
music_path04 = ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_分" & ".wav"
music_path05 = ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_開往" & ".wav"
music_path06 = ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_台北的" & ".wav"
music_path07 = ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_車次5" & ".wav"
music_path08 = ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_車次0" & ".wav"
music_path09 = ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_車次0" & ".wav"
music_path10 = ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_次" & ".wav"
music_path11 = ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_高鐵" & ".wav"
music_path12 = ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_北上" & ".wav"
music_path13 = ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_的列車即將進站請前往" & ".wav"
music_path14 = ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_第二月台" & ".wav"
music_path15 = ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_搭乘並留意月台間隙謝謝" & ".wav"

Dim Xwmp As IWMPMedia

工作表001.WindowsMediaPlayer1.currentPlaylist.Clear

Set Xwmp = 工作表001.WindowsMediaPlayer1.newMedia(music_path05)
工作表001.WindowsMediaPlayer1.currentPlaylist.insertItem 0, Xwmp

工作表001.WindowsMediaPlayer1.Controls.Play

Set Xwmp = 工作表001.WindowsMediaPlayer1.newMedia(music_path06)
工作表001.WindowsMediaPlayer1.currentPlaylist.insertItem 1, Xwmp

工作表001.WindowsMediaPlayer1.Controls.Play

Set Xwmp = 工作表001.WindowsMediaPlayer1.newMedia(music_path07)
工作表001.WindowsMediaPlayer1.currentPlaylist.insertItem 2, Xwmp

工作表001.WindowsMediaPlayer1.Controls.Play

Set Xwmp = 工作表001.WindowsMediaPlayer1.newMedia(music_path08)
工作表001.WindowsMediaPlayer1.currentPlaylist.insertItem 3, Xwmp

工作表001.WindowsMediaPlayer1.Controls.Play

End Sub
收藏 分享

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
2#
發表於 2016-1-20 09:57 | 只看該作者
回復 1# lshsien
你下面只插入第 5,6,7,8 首到撥放清單。
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

Joforn
　暱稱: 南宮飄雪

中學生Rank: 2

帖子
109 
主題
2 
精華
0 
積分
114 
點名
0  
作業系統
Win7 Win10 
軟體版本
Office 2019 WPS 
閱讀權限
20 
性別
男 
來自
深圳 
註冊時間
2013-2-2 
最後登錄
2024-4-9 
3#
發表於 2016-1-20 12:53 | 只看該作者
回復 1# lshsien
添加一個新的模塊，將下面的代碼粘貼到此模塊中：
  1. Option Explicit

  3. #If VBA7 Then
  4.   Private Declare PtrSafe Function waveOutGetNumDevs Lib "winmm.dll" () As Long
  5.   Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias "mciSendStringW" (ByVal lpstrCommand As LongPtr, ByVal lpstrRetumString As LongPtr, ByVal uReturnLength As Long, ByVal hwndCallback As LongPtr) As Long
  6.   Private Declare PtrSafe Function GetShortPathNameW Lib "kernel32" (ByVal lpszLongPath As LongPtr, ByVal lpszShortPath As LongPtr, ByVal cchBuffer As Long) As Long
  7.   Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  8.   Private Declare PtrSafe Function PathFindExtension Lib "shlwapi.dll" Alias "PathFindExtensionW" (ByVal pszPath As LongPtr) As LongPtr
  9.   Private Declare PtrSafe Function lStrLen Lib "kernel32.dll" Alias "lstrlenW" (ByVal lpString As LongPtr) As Long
  10.   Private Declare PtrSafe Sub CopyMemoryByPtr Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As LongPtr, ByVal Source As LongPtr, ByVal Length As Long)
  11. #Else
  12.   Private Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long
  13.   Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringW" (ByVal lpstrCommand As Long, ByVal lpstrRetumString As Long, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
  14.   Private Declare Function GetShortPathNameW Lib "kernel32" (ByVal lpszLongPath As Long, ByVal lpszShortPath As Long, ByVal cchBuffer As Long) As Long
  15.   Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  16.   Private Declare Function PathFindExtension Lib "shlwapi.dll" Alias "PathFindExtensionW" (ByVal pszPath As Long) As Long
  17.   Private Declare Function lStrLen Lib "kernel32.dll" Alias "lstrlenW" (ByVal lpString As Long) As Long
  18.   Private Declare Sub CopyMemoryByPtr Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
  19. #End If

  21. Private Type FileList
  22.   FileName  As String
  23.   ShortName As String
  24. End Type

  26. Private FileList() As FileList
  27. Private ListCount  As Long

  29. Public Sub Clean()
  30.   ListCount = 0
  31.   Erase FileList
  32. End Sub

  34. Public Property Get Item(ByVal Index As Long) As String
  35.   If Index > 0 And Index <= ListCount Then
  36.     Item = FileList(Index).FileName
  37.   End If
  38. End Property

  40. Public Property Let Item(ByVal Index As Long, ByVal FileName As String)
  41.   Dim I As Long
  42.   If Index = ListCount + 1 Then
  43.     ListCount = ListCount + 1
  44.     ReDim Preserve FileList(1 To ListCount)
  45.   End If
  46.   If (Index > 0) And (Index <= ListCount) Then
  47.     With FileList(Index)
  48.       .FileName = FileName
  49.       
  50.       I = Len(FileName)
  51.       If I > 0 Then
  52.         .ShortName = GetShortPathName(FileName)
  53.       Else
  54.         .ShortName = vbNullString
  55.       End If
  56.     End With
  57.   End If
  58. End Property

  60. Public Function ItemAdd(ByVal FileName As String) As Long
  61.   Dim I As Long
  62.   I = ListCount + 1
  63.   Item(I) = FileName
  64.   ItemAdd = I
  65. End Function

  67. Public Function ItemReMove(ByVal Index As Long) As Boolean
  68.   If Index > 0 And Index <= ListCount Then
  69.     With FileList(Index)
  70.       .FileName = vbNullString
  71.       .ShortName = vbNullString
  72.     End With
  73.   End If
  74. End Function

  76. Public Sub StartPlay()
  77.   Dim I         As Long
  78.   
  79.   If waveOutGetNumDevs > 0 Then
  80.     For I = 1 To ListCount Step 1
  81.       With FileList(I)
  82.         If Len(.ShortName) Then
  83.           Select Case UCase$(ExtractFileExtension(.ShortName))
  84.             Case ".WAV": mciSendString StrPtr("open " & .ShortName & " type waveaudio alias JofornMusic"), 0, 0, 0
  85.             Case ".MDI": mciSendString StrPtr("open " & .ShortName & " type sequencer alias JofornMusic"), 0, 0, 0
  86.             Case Else:   mciSendString StrPtr("open " & .ShortName & " alias JofornMusic"), 0, 0, 0
  87.           End Select
  88.           mciSendString StrPtr("play JofornMusic FROM 0"), 0&, 0, 0
  89.           Do While Not IsEnd
  90.             Sleep 50
  91.             DoEvents
  92.           Loop
  93.           mciSendString StrPtr("close JofornMusic"), 0&, 0, 0
  94.         End If
  95.       End With
  96.     Next I
  97.   End If
  98. End Sub

  100. Private Function IsEnd() As Boolean
  101.   Dim I         As Long
  102.   Dim strStatus As String
  103.   
  104.   strStatus = String$(256, vbNullChar)
  105.   mciSendString StrPtr("status JofornMusic mode"), StrPtr(strStatus), 256, 0
  106.   I = InStr(strStatus, vbNullChar)
  107.   If I > 1 Then
  108.     IsEnd = UCase$(Left$(strStatus, I - 1)) = "STOPPED"
  109.   Else
  110.     IsEnd = True
  111.   End If
  112. End Function

  114. '从路径提取文件后缀名
  115. Public Function ExtractFileExtension(ByVal strPath As String) As String
  116.   #If VBA7 Then
  117.     Dim ptrExt As LongPtr
  118.   #Else
  119.     Dim ptrExt As Long
  120.   #End If
  121.   Dim ExtLen As Long
  122.   
  123.   strPath = strPath & vbNullChar
  124.   ptrExt = PathFindExtension(StrPtr(strPath))
  125.   If ptrExt Then
  126.     ExtLen = lStrLen(ptrExt)
  127.     If ExtLen > 0 Then
  128.       ExtractFileExtension = String(ExtLen, vbNullChar)
  129.       CopyMemoryByPtr StrPtr(ExtractFileExtension), ptrExt, ExtLen * 2
  130.     End If
  131.   End If
  132. End Function

  134. Public Sub StopPlay()
  135.   mciSendString StrPtr("close JofornMusic"), 0&, 0, 0
  136. End Sub

  138. Private Function GetShortPathName(ByVal FileName As String) As String
  139.   Dim I       As Long
  140.   Dim strTemp As String
  141.   
  142.   strTemp = Space$(256)
  143.   I = GetShortPathNameW(StrPtr(FileName), StrPtr(strTemp), 256)
  144.   If I > 0 Then GetShortPathName = Left$(strTemp, I)
  145. End Function
複製代碼
將原有的代碼修改為：
  1. Public Sub macro_test2()

  3.     Dim Bk_A As String
  4.     Bk_A = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5)
  5.     '-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
  6.    
  7.     Dim book_name As String
  8.     Dim book_path As String
  9.    
  10.     book_name = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5)
  11.     book_path = ThisWorkbook.Path
  12.    
  13.     Clear
  14.     ItemAdd ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_各位旅客您好" & ".wav"
  15.     ItemAdd ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_6點" & ".wav"
  16.     ItemAdd ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_分50" & ".wav"
  17.     ItemAdd ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_分" & ".wav"
  18.     ItemAdd ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_開往" & ".wav"
  19.     ItemAdd ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_台北的" & ".wav"
  20.     ItemAdd ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_車次5" & ".wav"
  21.     ItemAdd ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_車次0" & ".wav"
  22.     ItemAdd ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_車次0" & ".wav"
  23.     ItemAdd ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_次" & ".wav"
  24.     ItemAdd ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_高鐵" & ".wav"
  25.     ItemAdd ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_北上" & ".wav"
  26.     ItemAdd ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_的列車即將進站請前往" & ".wav"
  27.     ItemAdd ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_第二月台" & ".wav"
  28.     ItemAdd ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_搭乘並留意月台間隙謝謝" & ".wav"
  29.     StartPlay
  30. End Sub
複製代碼
完成上面的兩步操作後運行macro_test2測試。
世界那麼大，可我想去哪？

TOP

Joforn
　暱稱: 南宮飄雪

中學生Rank: 2

帖子
109 
主題
2 
精華
0 
積分
114 
點名
0  
作業系統
Win7 Win10 
軟體版本
Office 2019 WPS 
閱讀權限
20 
性別
男 
來自
深圳 
註冊時間
2013-2-2 
最後登錄
2024-4-9 
4#
發表於 2016-1-20 13:00 | 只看該作者
注：樓上的代碼不需要MediaPlayer控件。
世界那麼大，可我想去哪？

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
5#
發表於 2016-1-20 19:02 | 只看該作者
回復 1# lshsien
正如 Joforn 大大所提示的，以下的
代碼不需要 MediaPlayer 的支援控件。
如果你較習慣使用 MediaPlayer 控件
那麼你便可以不用往下閱覽了。
  1. Option Explicit

  3. Private Const SND_APPLICATION = &H80         '  look for application specific association
  4. Private Const SND_ALIAS = &H10000            '  name is a WIN.INI [sounds] entry
  5. Private Const SND_ALIAS_ID = &H110000        '  name is a WIN.INI [sounds] entry identifier
  6. Private Const SND_ASYNC = &H1                '  play asynchronously
  7. Private Const SND_FILENAME = &H20000         '  name is a file name
  8. Private Const SND_LOOP = &H8                 '  loop the sound until next sndPlaySound
  9. Private Const SND_MEMORY = &H4               '  lpszSoundName points to a memory file
  10. Private Const SND_NODEFAULT = &H2            '  silence not default, if sound not found
  11. Private Const SND_NOSTOP = &H10              '  don't stop any currently playing sound
  12. Private Const SND_NOWAIT = &H2000            '  don't wait if the driver is busy
  13. Private Const SND_PURGE = &H40               '  purge non-static events for task
  14. Private Const SND_RESOURCE = &H40004         '  name is a resource name or atom
  15. Private Const SND_SYNC = &H0                 '  play synchronously (default)

  17. #If VBA7 Then
  18.     Private Declare PtrSafe Function PlaySoundA Lib "winmm.dll" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
  19.     '  以上係 .Wav 檔之參數宣告； 下列三行為 .MP3 檔案宣告之引用功能函式及變數宣告。
  20.     Private Declare PtrSafe 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
  21.     Private Declare PtrSafe Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
  22. #Else
  23.     Private Declare Function PlaySoundA Lib "winmm.dll" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
  24.     '  以上係 .Wav 檔之參數宣告； 下列三行為 .MP3 檔案宣告之引用功能函式及變數宣告。
  25.     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
  26.     Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
  27. #End If

  29. Dim Mp3File, LastMp3File As String, lst() As String, idx As Long

  31. Sub Ex()
  32.     Dim cnt As Long
  33.    
  34.     idx = 0
  35.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_各位旅客您好.wav")
  36.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_6點.wav")
  37.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_分50.wav")
  38.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_分.wav")
  39.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_開往.wav")
  40.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_台北的.wav")
  41.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_車次5.wav")
  42.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_車次0.wav")
  43.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_車次0.wav")
  44.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_次.wav")
  45.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_高鐵.wav")
  46.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_北上.wav")
  47.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_的列車即將進站請前往.wav")
  48.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_第二月台.wav")
  49.     addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_搭乘並留意月台間隙謝謝.wav")
  50.         
  51.     For cnt = 1 To UBound(lst)
  52.         If UCase(Right(lst(cnt), 4)) = ".WAV" Then
  53.             PlaySound (lst(cnt))
  54.         ElseIf UCase(Right(lst(cnt), 4)) = ".MP3" Then
  55.             MMStop (LastMp3File)
  56.             LastMp3File = lst(cnt)
  57.             MMPlay (lst(cnt))
  58.         End If
  59.     Next cnt
  60.         
  61.     rmvList
  62. End Sub

  64. Public Function addList(ByVal fn As String)
  65.     Dim num As Long
  66.    
  67.     If idx = 0 Then num = 1 Else num = UBound(lst) + 1
  68.     ReDim Preserve lst(num)
  69.     lst(num) = fn
  70.     idx = idx + 1
  71. End Function

  73. Public Function rmvList()
  74.     If idx = 0 Then Exit Function
  75.     ReDim Preserve lst(0)   '  lst :  String(0 to 0)
  76.     idx = 0                 '  UBound(lst) = 0 : Long
  77. End Function

  79. ' Purpose     :  Plays an audio file
  80. ' Inputs      :  sFilePath           The location of the wav file
  81. '                lFlags              Can be one or many of the constants given above
  82. ' Outputs     :  The text found on the web site
  83. ' Author      :  Andrew Baker
  84. ' Date        :  21/10/2000 12:37
  85. ' Notes       :  Code adapted from code found on www.allapi.net (excellent site!)
  86. ' Revisions   :

  88. Function PlaySound(sFilePath As String, Optional lFlags As Long = SND_FILENAME Or SND_ASYNC) As Long
  89.     PlaySound = PlaySoundA(sFilePath, 0&, lFlags)
  90. End Function

  92. Function ConvShortFilename(ByVal strLongPath$) As String
  93.     Dim strShortPath$
  94.     If InStr(1, strLongPath, " ") Then
  95.         strShortPath = String(LenB(strLongPath), Chr(0))
  96.         GetShortPathName strLongPath, strShortPath, Len(strShortPath)
  97.         ConvShortFilename = Left(strShortPath, InStr(1, strShortPath, Chr(0)) - 1)
  98.     Else
  99.         ConvShortFilename = strLongPath
  100.     End If
  101. End Function

  103. Private Sub MMPlay(ByRef FileName As String)
  104.     FileName = ConvShortFilename(FileName)
  105.     mciSendString "close " & FileName, vbNullString, 0, 0
  106.     mciSendString "open " & FileName, vbNullString, 0, 0
  107.     mciSendString "play " & FileName, vbNullString, 0, 0
  108. End Sub

  110. Private Sub MMStop(ByRef FileName As String)
  111.     FileName = ConvShortFilename(FileName)
  112.     mciSendString "stop " & FileName, vbNullString, 0, 0
  113.     mciSendString "close " & FileName, vbNullString, 0, 0
  114. End Sub
複製代碼
1

評分人數

TOP

lshsien

帖子
6 
主題
2 
精華
0 
積分
37 
點名
0  
作業系統
win7 
軟體版本
office2010 
閱讀權限
10 
性別
男 
註冊時間
2014-4-15 
最後登錄
2019-1-15 
6#
發表於 2016-1-22 11:44 | 只看該作者
To stillfish00大大
不好意思，小弟沒貼到後面的。
To Joforn、c_c_lai兩位大大
感謝您的指導，目前正在努力測試中，
因小弟學習剛起步，對於兩位大大所寫的還是一知半解，
目前努力的理解中，
想請問大大，若使用MediaPlayer 控件，
是否有辦法解決小弟的問題，
謝謝!

TOP

准提部林

帖子
2798 
主題
10 
精華
0 
積分
2854 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-4-15 
7#
發表於 2016-1-22 13:12 | 只看該作者
以〔短語音〕mp3實測，
WindowsMediaPlayer並無四檔即停播問題，

或許上傳檔案較可能找出原因∼∼

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
8#
發表於 2016-1-22 18:48 | 只看該作者
回復 6# lshsien
雖然你偏好使用 Windows Media Player，
但我使用 Joforn 大大提供的程式碼測試
三種型態的媒體檔 (*.mp3;*.wav;*.mp4)
它在執行撥放過程非常穩定，DoEvents 的
時段拿捏得恰當，尤其是 mp4 影片撥放
視窗也很流暢，蠻值得你採用。其實
Windows Media Player元件亦使用同樣之
Windows System 程式庫 (Lib)。
  1. Sub Ex()
  2.     ItemAdd (ThisWorkbook.Path & "\" & "大悲咒天使波羅蜜.wav")
  3.     ItemAdd (ThisWorkbook.Path & "\" & "舒伯特 小夜曲 大提琴演奏 .mp4")
  4.     ItemAdd (ThisWorkbook.Path & "\" & "寶篋咒.mp3")
  5.     ItemAdd (ThisWorkbook.Path & "\" & "聖誕快樂 01.mp4")
  6.     ItemAdd (ThisWorkbook.Path & "\" & "01_巴哈 G弦之歌 Air On the G string.mp3")
  7.     ItemAdd (ThisWorkbook.Path & "\" & "舒伯特 小夜曲 大提琴演奏 .mp4")
  8.     ItemAdd (ThisWorkbook.Path & "\" & "02_NOCTURNE.mp3")
  9.     ItemAdd (ThisWorkbook.Path & "\" & "03_SAULT D' AMOUR.mp3")
  10.     ItemAdd (ThisWorkbook.Path & "\" & "04_JUNE(BARCAROLLE).mp3")
  11.    
  12.     StartPlay
  13. End Sub
複製代碼

TOP

ML089

帖子
2025 
主題
13 
精華
0 
積分
2053 
點名
0  
作業系統
WIN7 
軟體版本
Office2007 
閱讀權限
100 
性別
男 
來自
台北市 
註冊時間
2011-3-2 
最後登錄
2024-3-14 

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
9#
發表於 2016-1-22 20:04 | 只看該作者
回復 3# Joforn

請問播放以後如何臨時暫停或中斷撥放
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

Joforn
　暱稱: 南宮飄雪

中學生Rank: 2

帖子
109 
主題
2 
精華
0 
積分
114 
點名
0  
作業系統
Win7 Win10 
軟體版本
Office 2019 WPS 
閱讀權限
20 
性別
男 
來自
深圳 
註冊時間
2013-2-2 
最後登錄
2024-4-9 
10#
發表於 2016-1-23 12:32 | 只看該作者
回復  Joforn

請問播放以後如何臨時暫停或中斷撥放
ML089 發表於 2016-1-22 20:04
  1. Public Property Get Pause() As Boolean
  2.   Dim I         As Long
  3.   Dim strStatus As String
  4.   
  5.   strStatus = String$(256, vbNullChar)
  6.   mciSendString StrPtr("status JofornMusic mode"), StrPtr(strStatus), 256, 0
  7.   I = InStr(strStatus, vbNullChar)
  8.   If I > 1 Then
  9.     Debug.Print Left$(strStatus, I - 1)
  10.     Pause = UCase$(Left$(strStatus, I - 1)) = "PAUSED"
  11.   End If
  12. End Property

  14. Public Property Let Pause(ByVal Value As Boolean)
  15.   If Value Xor Pause Then
  16.     If Value Then
  17.       mciSendString StrPtr("pause JofornMusic"), 0, 0, 0
  18.     Else
  19.       mciSendString StrPtr("resume JofornMusic"), 0, 0, 0
  20.     End If
  21.   End If
  22. End Property
複製代碼
調用Pause=True就可以暫停，Pause=False繼續播放。
世界那麼大，可我想去哪？

TOP

        靜思自在 : 有智慧才能分辨善惡邪正；有謙虛才能建立美滿人生。
12
返回列表 上一主題