楼主
轩辕轼轲 |
Q：有时候公司的电脑禁用了播放器，导致连听歌的要求都无法实现，有没有用办公软件做的播放器，不留痕迹地突**管对电脑的限制？
A：用VBA调用WMP组件就可以播放WMP能支持的所有格式的音频文件，实现代码如下：
第一步：在Sheet1里面添加三个按钮播放本地文件、播放网络文件、和停止播放，并在Sheet1里面添加下面的代码：
- Dim Mp3File, LastMp3File As String
- Private Sub CommandButton1_Click()
- Mp3File = Application.GetOpenFilename("*.mp3,*.mp3", , "打开mp3文件")
- If Mp3File = False Then '没有打开任何MP3文件
- Mp3File = LastMp3File
- Exit Sub
- End If
- MMStop (LastMp3File) '停止正在播放的MP3文件
- LastMp3File = Mp3File
- MMPlay (Mp3File)
- Cells(1, 1) = "播放的文件为：" & Mp3File
- End Sub
- Private Sub CommandButton2_Click()
- MMStop (Mp3File)
- Cells(1, 1) = ""
- End Sub
- Private Sub CommandButton3_Click()
- Mp3File = "http://www.xixivi.com/attachments/month_1001/42010121223423.mp3" '此处根据自己的需要修改
- MMPlay (Mp3File)
- Cells(1, 1) = "播放的文件为：" & Mp3File
- End Sub
第二步：创建一个公共模块，并添加下面的代码：
- Option Explicit
- Public 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
- Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
- Private 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
- Public 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
- Public Sub MMStop(ByRef FileName As String)
- FileName = ConvShortFilename(FileName)
- mciSendString "stop " & FileName, vbNullString, 0, 0
- mciSendString "close " & FileName, vbNullString, 0, 0
- End Sub
效果见下方附件：
 用Excel做的简易音频播放器.rar
|