ExcelTip.Net留存知识帖 ---【注：附件之前被网盘供应商清空后，现已修复-现已修复-现已修复为本地下载！】
现在位置：首页 > 动画教程 > Excel VBA > 用VBA模拟音乐播放器

用VBA模拟音乐播放器

作者：绿色风 分类： 时间：2022-08-18 浏览：178
楼主
yjzstar		 用VBA虚拟了一个音乐播放器，具体效果如下！

 
  1. 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
  2. Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
  3. Dim x As Boolean
  4. Dim Mp3name As String
  5. Private Function ConvShortFilename(ByVal strLongPath$) As String
  6.     Dim strShortPath$
  7.     If InStr(1, strLongPath, " ") Then
  8.         strShortPath = String(LenB(strLongPath), Chr(0))
  9.         GetShortPathName strLongPath, strShortPath, Len(strShortPath)
  10.         ConvShortFilename = Left(strShortPath, InStr(1, strShortPath, Chr(0)) - 1)
  11.     Else
  12.         ConvShortFilename = strLongPath
  13.     End If
  14. End Function
  15. Public Sub MPlay(ByRef FileName As String)
  16.     FileName = ConvShortFilename(FileName)
  17.     mciSendString "close " & FileName, vbNullString, 0, 0
  18.     mciSendString "open " & FileName, vbNullString, 0, 0
  19.     mciSendString "play " & FileName, vbNullString, 0, 0
  20. End Sub
  21. Public Sub MStop(ByRef FileName As String)
  22.     FileName = ConvShortFilename(FileName)
  23.     mciSendString "stop " & FileName, vbNullString, 0, 0
  24.     mciSendString "close " & FileName, vbNullString, 0, 0
  25. End Sub
  26. Sub dd()
  27.     Dim i As Integer
  28.     Dim j As Integer
  29.     Dim n As Integer
  30.     [B12] = [A21]
  31.     Do
  32.         For j = 1 To 8000
  33.             DoEvents
  34.         Next
  35.         For n = 2 To 28
  36.             i = Rnd() * 10
  37.             If i = 0 Then i = i + 1
  38.             Range(Cells(2, n), Cells(10, n)).Interior.Color = RGB(95, 59, 67)
  39.             Range(Cells(i + 1, n), Cells(10, n)).Interior.Color = RGB(248, 82, 216)
  40.         Next
  41.         i = Rnd() * 255
  42.         i1 = Rnd() * 255
  43.         i1 = Rnd() * 255
  44.             Range("B14").Font.Color = RGB(i, i1, i2)
  45.         [B12] = Mid([B12], 2, Len([B12]) - 1) & Left([B12], 1)
  46.     Loop Until x = False
  47.    
  48. End Sub
  49. Sub 停()
  50. x = False
  51. [B12] = "    制作：yjzstar    @EXCEL_VBA爱好者"
  52. MStop (Mp3name)
  53. End Sub
  54. Sub 开始()
  55.     x = True
  56.     Mp3name = ThisWorkbook.Path & "\新贵妃醉酒.mp3"
  57.     MPlay (Mp3name)
  58.     Call dd
  59. End Sub

EXCEL虚拟音乐播放.rar
2003版EXCEL虚拟播放器.rar
2楼
YESS95		 牛叉啊！跟你学，很炫
3楼
CheryBTL		 COOL～～～

4楼
千年一梦遥		 看着就觉得很炫!
5楼
xyf2210		 牛人
6楼
lslly		 酷               
7楼
lrlxxqxa		 这个播放器有音乐吗？我怎么听不到声音呢
8楼
yjzstar		 音乐可以添加上去，但附件可能有点大，我抽时间把音乐剪切下放上来！
9楼
lrlxxqxa		 如果能有音乐最好不过啦，附件能上传就行，如果实在太大就算了
10楼
yjzstar		 我努力试一下吧！
11楼
yjzstar		 锐哥，已经添加音乐了，具体请下载附件！
12楼
lrlxxqxa		 单位没耳机，回家欣赏
13楼
yjzstar
14楼
特洛伊木马		 帅**！
15楼
辉歌_忧殇Bryant		 哇哦，不错吖
16楼
阙之月		 谢谢分享，把vba学到这样子就不容易了
17楼
吕渠田		 这个真心**
18楼
xb2012		 这个播放器要怎么弄？
19楼
BySilly		 厉害！ 。。
20楼
婆婆

21楼
象象lover		 我艹****网站 登录这么难吗？！
我特么从登录到下载登录了8遍了还登不上去
什么意思啊？！
22楼
zhfr		 怎么弄才能够播放啊？
23楼
yjzstar		 启用宏之后直接点开始就可以播放了！
24楼
zhfr		 哈 谢了 刚刚不知道怎么点就能播放了 谢谢分享
25楼
无口有心QQ		 请问代码要放在哪里运行啊
26楼
No.nOう		 vba是什么~~~
27楼
sylzldd		 收藏学习。
28楼
yjzstar		 请直接下载附件，启用宏之后就可以运行了！
29楼
hrmanagement		 酷毙了~@@换歌进行了试听，真不错。
30楼
wpppj		 好东西。从03版和07以上版本的下载人数来看，用07以上版本的同志占了七成以上。
31楼
hl_irnt
32楼
xjycm		 牛啊，太厉害了****~
33楼
dawin2046		 有创意。
34楼
小强_加油！
35楼
hylees		 炫呀~
36楼
纳米哥斯拉		 我也要下载
37楼
pixar		 太犀利了……
38楼
yjzstar		 的确！
39楼
小懒牛牛		 想要换首歌该怎么弄呢？
40楼
pengjia89		 Mp3name = ThisWorkbook.Path & "\新贵妃醉酒.mp3"
这行换成你歌曲的目录，再把sheet2里面的歌词换成你的歌词就好了…………


话说我下的03的，歌词走得有点快嘛
41楼
天地你独行		 为什么在 sheet2换了歌词，播放器却不换呢？
42楼
yjzstar		 歌词放在B12中
43楼
天地你独行		 谢谢你哦，我一点都不懂VBA。我把代码研究了一多个小时，还百度了mid,len等是啥意思，最后发现一句话B12=A21.我在A21里换了歌词
。谢谢你啊
44楼
天地你独行		 不过，我把你的名字换成我的了，网址也换成我QQ空间了后送给了女朋友，她说了句："不是你唱的啊."
...囧.....谢谢你，感谢！
45楼
yjzstar		 客气
46楼
TET		 换了另外一首歌，要怎样改掉歌词呢
47楼
cumhp		 谢谢！楼主提供！好样的











偷米者 逼
48楼
gongannet		 谢谢分享********！
49楼
oldcpu		 慕名而来！~围观！~~
50楼
oldcpu		 64位系统无法使用
51楼
陈志敏-小黑		 谢谢分享！
52楼
cuteevaace		 怎么解压缩不行啊
53楼
monk514		 太神奇了，呵呵
54楼
医生那些事		 wps的能用吗？？？
55楼
柠檬草的味道		 可以自己换音乐吗
56楼
lilygong		 楼主牛X!!!
57楼
biangbiang--		 太酷了**

58楼
fukadalwx		 最好改进一下，加个控件打开哪个音乐文件，就放哪个音乐。
59楼
流氓		 太帅了，研究一下
60楼
逆留的卐Feng
61楼
SPAR		 亲，怎样添加歌曲呀？
62楼
逍遥的企鹅		 感谢LZ分享，学习一下
63楼
沪♂坏人		 这个好啊！我学习一下。
64楼
沪♂坏人		 刚试了一下，直接是太经典啦！
65楼
eying		 神级啊，厉害。
66楼
hefanzone		 64位系统 运行不出来****
67楼
tianyutiangong		 厉害
68楼
神啊救救我吧		 64位系统打不开
69楼
_左耳末的空耳洞		 膜拜，太厉害了。
70楼
企鹅要飞		 牛人
71楼
sstjf		 学习学习
72楼
adolphfend		 好神奇啊**！
73楼
jinlinhh		 厉害啊~
74楼
maxizer0218		 很神奇，但是好可怕~~~从0开始学起去
75楼
palmli		 围脖上发的那个Excel音乐播放器，我下载了不能用，是什么问题？QQ截图20130419220024.jpg
 
76楼
eliane_lei		 真牛，先下载下来学习！
77楼
翔子		 强大啊，原来excel还能干这个
78楼
yirenxiangtao		 牛
79楼
keven		 求教 能不能把具体的算法思路说一下，或者您把代码注释一下我也想自己做一个excel音乐播放器！
80楼
E林好汉		 一个字：酷、炫
81楼
hellojiakun		 牛X！
82楼
Mack046		 酷，怎么做的呢？？有没有教程啊？
83楼
peterzhu0810		 学习学习
84楼
是哈玲		 好厉害呀
85楼
ks-108		 牛！
86楼
lrlxxqxa		 这个很给力！
87楼
海洋之星		 学习
88楼
海洋之星		 学习
89楼
yingtian4000		 很酷
90楼
yanlihua070406		 太炫了！
91楼
kjmtip		 好东西，辛苦了
92楼
yingtian4000		 学习学学看看
93楼
yeminqiang



94楼
我记得我爱你		 谢谢
95楼
yingtian4000		 我努力的学习下

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素， 经与ExcelTip.Net站长Apolloh商议并征得其同意， 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示， 供有需要的人士查询使用，也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议， 可与本人沟通提出，或于本站点留言，我们会尽快处理。 在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

猜您喜欢
评论列表
搜索

鄂ICP备2021011689号-2

powered by emlog pro Theme By 蓝叶

sitemap