- 帖子
- 2035
- 主題
- 24
- 精華
- 0
- 積分
- 2031
- 點名
- 0
- 作業系統
- Win7
- 軟體版本
- Office2010
- 閱讀權限
- 100
- 性別
- 男
- 註冊時間
- 2012-3-22
- 最後登錄
- 2024-2-1
|
回復 1# lshsien
正如 Joforn 大大所提示的，以下的
代碼不需要 MediaPlayer 的支援控件。
如果你較習慣使用 MediaPlayer 控件
那麼你便可以不用往下閱覽了。- Option Explicit
- Private Const SND_APPLICATION = &H80 ' look for application specific association
- Private Const SND_ALIAS = &H10000 ' name is a WIN.INI [sounds] entry
- Private Const SND_ALIAS_ID = &H110000 ' name is a WIN.INI [sounds] entry identifier
- Private Const SND_ASYNC = &H1 ' play asynchronously
- Private Const SND_FILENAME = &H20000 ' name is a file name
- Private Const SND_LOOP = &H8 ' loop the sound until next sndPlaySound
- Private Const SND_MEMORY = &H4 ' lpszSoundName points to a memory file
- Private Const SND_NODEFAULT = &H2 ' silence not default, if sound not found
- Private Const SND_NOSTOP = &H10 ' don't stop any currently playing sound
- Private Const SND_NOWAIT = &H2000 ' don't wait if the driver is busy
- Private Const SND_PURGE = &H40 ' purge non-static events for task
- Private Const SND_RESOURCE = &H40004 ' name is a resource name or atom
- Private Const SND_SYNC = &H0 ' play synchronously (default)
- #If VBA7 Then
- Private Declare PtrSafe Function PlaySoundA Lib "winmm.dll" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
- ' 以上係 .Wav 檔之參數宣告； 下列三行為 .MP3 檔案宣告之引用功能函式及變數宣告。
- 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
- Private Declare PtrSafe Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
- #Else
- Private Declare Function PlaySoundA Lib "winmm.dll" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
- ' 以上係 .Wav 檔之參數宣告； 下列三行為 .MP3 檔案宣告之引用功能函式及變數宣告。
- 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
- Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
- #End If
- Dim Mp3File, LastMp3File As String, lst() As String, idx As Long
- Sub Ex()
- Dim cnt As Long
-
- idx = 0
- addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_各位旅客您好.wav")
- addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_6點.wav")
- addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_分50.wav")
- addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_分.wav")
- addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_開往.wav")
- addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_台北的.wav")
- addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_車次5.wav")
- addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_車次0.wav")
- addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_車次0.wav")
- addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_次.wav")
- addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_高鐵.wav")
- addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_北上.wav")
- addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_的列車即將進站請前往.wav")
- addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_第二月台.wav")
- addList (ThisWorkbook.Path & "\" & "常用廣播" & "\" & "國語_搭乘並留意月台間隙謝謝.wav")
-
- For cnt = 1 To UBound(lst)
- If UCase(Right(lst(cnt), 4)) = ".WAV" Then
- PlaySound (lst(cnt))
- ElseIf UCase(Right(lst(cnt), 4)) = ".MP3" Then
- MMStop (LastMp3File)
- LastMp3File = lst(cnt)
- MMPlay (lst(cnt))
- End If
- Next cnt
-
- rmvList
- End Sub
- Public Function addList(ByVal fn As String)
- Dim num As Long
-
- If idx = 0 Then num = 1 Else num = UBound(lst) + 1
- ReDim Preserve lst(num)
- lst(num) = fn
- idx = idx + 1
- End Function
- Public Function rmvList()
- If idx = 0 Then Exit Function
- ReDim Preserve lst(0) ' lst : String(0 to 0)
- idx = 0 ' UBound(lst) = 0 : Long
- End Function
- ' Purpose : Plays an audio file
- ' Inputs : sFilePath The location of the wav file
- ' lFlags Can be one or many of the constants given above
- ' Outputs : The text found on the web site
- ' Author : Andrew Baker
- ' Date : 21/10/2000 12:37
- ' Notes : Code adapted from code found on www.allapi.net (excellent site!)
- ' Revisions :
- Function PlaySound(sFilePath As String, Optional lFlags As Long = SND_FILENAME Or SND_ASYNC) As Long
- PlaySound = PlaySoundA(sFilePath, 0&, lFlags)
- End Function
- Function ConvShortFilename(ByVal strLongPath$) As String
- Dim strShortPath$
- If InStr(1, strLongPath, " ") Then
- strShortPath = String(LenB(strLongPath), Chr(0))
- GetShortPathName strLongPath, strShortPath, Len(strShortPath)
- ConvShortFilename = Left(strShortPath, InStr(1, strShortPath, Chr(0)) - 1)
- Else
- ConvShortFilename = strLongPath
- End If
- End Function
- Private Sub MMPlay(ByRef FileName As String)
- FileName = ConvShortFilename(FileName)
- mciSendString "close " & FileName, vbNullString, 0, 0
- mciSendString "open " & FileName, vbNullString, 0, 0
- mciSendString "play " & FileName, vbNullString, 0, 0
- End Sub
- Private Sub MMStop(ByRef FileName As String)
- FileName = ConvShortFilename(FileName)
- mciSendString "stop " & FileName, vbNullString, 0, 0
- mciSendString "close " & FileName, vbNullString, 0, 0
- End Sub
|
-
1
評分人數
-
|
發表於 2016-1-20 19:02
| 
