Joforn

回復 1# lshsien
添加一個新的模塊，將下面的代碼粘貼到此模塊中：

1. Option Explicit
   
2. 
   
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
    
20. 
    
21. Private Type FileList
    
22.   FileName  As String
    
23.   ShortName As String
    
24. End Type
    
25. 
    
26. Private FileList() As FileList
    
27. Private ListCount  As Long
    
28. 
    
29. Public Sub Clean()
    
30.   ListCount = 0
    
31.   Erase FileList
    
32. End Sub
    
33. 
    
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
    
39. 
    
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
    
59. 
    
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
    
66. 
    
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
    
75. 
    
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
    
99. 
    
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
     
113. 
     
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
     
133. 
     
134. Public Sub StopPlay()
     
135.   mciSendString StrPtr("close JofornMusic"), 0&, 0, 0
     
136. End Sub
     
137. 
     
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()
   
2. 
   
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測試。

Joforn

注：樓上的代碼不需要MediaPlayer控件。

Joforn

回復  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
    
13. 
    
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繼續播放。

Joforn

mciSendString函數是用來播放多媒體文件的API指令，可以播放MPEG,AVI,WAV,MP3,等等，使用此API函數可以創建一個簡易的播放器，下面介紹它的使用方法：
　　該函數有四個參數：
第一個參數：要發送的命令字符串。字符串結構是:[命令][設備別名][命令參數].
第二個參數：返回信息的緩衝區,為一指定了大小的字符串變量.
第三個參數：緩衝區的大小,就是字符變量的長度.
第四個參數：回調方式，一般設為零
返回值：函數執行成功返回零，否則返回錯誤代碼

一、常用命令
1.打開（Open），格式：Open 設備名[type 設備型式][alias 別名]
Dim mName as string
mName = "f:\mpeg\mpeg1.avi"
mciSendString "open " & mName & " type MPEGVideo Alias​​ JofornMusic parent %u Style %u notify",0&, 0, 0
　其中：
open 操作命令
mName 全路徑文件名
type MPEGVideo 是指打開MPEG,AVI等類型，如果不加這一句，就是打開WAV,MP3等
Alias​​ JofornMusic 定義了該操作的別名為movie，後續操作只要指明別名即可
parent %u 源
Style %u 樣式
notify 通知
2.播放（Play），格式：Play 設備名[from 起點][to 終點]
mciSendString "play JofornMusic", 0&, 0, 0
mciSendString "play JofornMusic fullscreen", 0&, 0, 0 '全屏播放
　　3.暫停（Pause）：
mciSendString "pause JofornMusic", 0&, 0, 0
　　4.繼續（Resume）：
mciSendString "resume JofornMusic", 0&, 0, 0
　　5.停止（Stop）：
mciSendString "stop JofornMusic", 0&, 0, 0
　　6.​​關閉（Colse）：
mciSendString "close JofornMusic", 0&, 0, 0
　　7.前進到下一個位置：
mciSendString "step JofornMusic", 0&, 0, 0
　　8.後退到上一個位置：
mciSendString "step JofornMusic reverse", 0&, 0, 0
9.前進或後退N 個位置(其中N<0 即表示後退)
mciSendString "step JofornMusic by " & str(N), 0&, 0, 0
　　10.獲取當前播放位置：
Dim ST As String*64
mciSendString "status JofornMusic position", st, len(st), 0
　　11. ​​獲取媒體的總長度：
mciSendString "status JofornMusic length", st, len(st), 0
l=val(st) 'l就是所播放文件的長度
　　12.獲取播放當前狀態：
Dim ST As String*64
mciSendString "status JofornMusic mode", ST, Len(ST), 0
If Left(ST, 7) = "stopped" Then (處理代碼) '播放完畢
　　13.循環播放：
mciSendString "play JofornMusic repeat", 0&, 0, 0

二、控制聲音大小(1-1000)：
Dim V As Long
mciSendString "status JofornMusic volume",&V, len(v), 0 'V是獲取的音量大小值。
V = 50
mciSendString "setaudio JofornMusic volume to 數值", 0, 0, 0 'V是設置的音量值

三、設置播放位置.(需事先設定時間格式)，格式：Seek 設備名[to 位置| to start | to end]
Dim P1 as Long, P2 as Long
P1 = 100: P2 = 3000
mciSendString "seek JofornMusic to ", P1, 0, 0 'P1是當前起始位置，單位：毫秒
mciSendString "seek JofornMusic to start", 0&, 0, 0 '定位到開頭位置
mciSendString "play JofornMusic", 0&, 0, 0 '定位後再播放
或者：
mciSendString "play JofornMusic FROM P1 to P2",0&, 0, 0 'P1是起始位置，P2是停止位置。單位：毫秒
mciSendString "seek JofornMusic to end", 0&, 0, 0 '定位到最後位置

四、在指定控件上播放視頻：
mciSendString "open AVI 文件名parent hWnd style child", 0&, 0, 0
其中，hWnd 是控件的句柄
執行上述命令之後，影片會被放置在控件的左上角，且影片的大小不受控件大小的影響，如果想要改變
影片播放的位置及大小，可以在執行play 指令前先執行put 指令，格式如下：
mcisendString "put AVI 文件名window at XY [Width Height]", 0&, 0, 0
其中：X、Y為影片左上角坐標，Width、Height為影片的寬高度

五、如果播放視頻還可控制亮度(1-2000)
Dim B As Long
mciSendString "status JofornMusic brightness", B, 0, 0 'B是獲取的亮度值。
B = 50
mciSendString "setvideo JofornMusic brightness to " & B, &0, 0, 0 'B是設置的亮度值

六、錄音設置：
　　錄音前，用以下語句初始化
　　1.設為8位：
mciSendString "set wave bitpersample 8", "", 0, 0
　　2.設為11025Hz
mciSendString "set wave samplespersec 11025", "", 0, 0
　　3.設為立體聲：
mciSendString "set wave channels 2", "", 0, 0
　　4.實現PCM格式（不一定正確）：
MCISENDSTRING "set wave format tag pcm","", 0, 0
　　5.開始錄音：
mciSendString "close JofornMusic",0&,0,0
mciSendString "open new type WAVEAudio alias JofornMusic",0&,0,0
mciSendString "record JofornMusic",0&,0,0
　　6.​​保存錄音到c:\123.wav
mciSendString "stop JofornMusic",0&,0,0
mciSendString "save JofornMusic C:\123.wav",0&,0,0
mciSendString "close JofornMusic",0&,0,0

七、開關光驅：
mciSendString "set cdaudio door open", "", 0, 0 '打開
mciSendString "set cdaudio door close", "", 0, 0 '關閉

八、其它
　　1.設置設備的各種狀態（Set）
Set alias_name[audio all off][audio all on][time format ms]:
Set命令用來設置設備的各種狀態.如:靜音,有聲音,時間格式為毫秒等.
　　2.取得設備的狀態（Status）
Status alias_name[length][mode][position]:
Status命令用來取得設備的狀態.如:該媒體文件的長度,該媒體文件所處狀態,該媒體文件的當前位置等. 的長度,該媒體文件所處狀態,該
媒體文件的當前位置等.
參考代碼：
TCHAR fileName[]="D:\俺的文檔\my music\爺爺泡的茶.mp3";
TCHAR shortName[MAX_PATH];
GetShortPathName(fileName,shortName,sizeof(shortName)/sizeof(TCHAR));
TCHAR cmd[MAX_PATH+10];
wsprintf(cmd,"play %s",shortName);
mciSendString(cmd,"",NULL,NULL);
（調用mciSendString第一個參數傳“play 文件全路徑”就可以，“文件全路徑”最好傳絕對路徑，不建議wanghepeng10那樣值傳遞文件名。
另外如果文件全路徑中含有空格的話要使用GetShortPathName轉換成短路徑。 ）

Joforn

回復  Joforn
回復  c_c_lai

想不道 EXCEL 除計算外，還能撥放音樂，各路英雄的踴躍發表讓EXCEL越來越 ...
ML089 發表於 2016-1-23 15:22

要先安裝相關的解碼器，不過本人沒有具體測試過，你可以自己測試下，但要注意的是調用時指定好用來顯示畫面的窗體句柄。