小黄鸭官网（小黄鸭视频app下载-小黄鸭新版）

今天来点好玩的，抖音上小黄鸭火了一把，超多人模仿。循环播放不能自已。

抖音小黄鸭

我们来用VBA制作一个动态的小黄鸭，并且播放音乐。

▌先上效果：

因为要切换Worksheet屏幕刷新必须关掉才能看到动态变化过程，有点闪瞎眼睛

音乐播放框不想要可以用代码隐藏掉。

▌来说一下制作原理

Excel本身功能直接插入gif图片是不会动态变化的，除非加专门的控件，才能动态显示。我们这里不用控件。

小黄鸭.gif

●这里是将小黄鸭.gif关键帧图片分别导入到单个Sheet中央位置。循环激活含有小黄鸭图片的Sheet，就会出现动态变化的效果。

●利用API ShellExecute函数打开背景音乐文件

ShellExecute的功能是运行一个外部程序（或打开一个目录、打印一个文件等等），并对外部程序有一定的控制。

▌代码及详解

●插入小黄鸭关键帧图片到每个Worksheet中

Sub 插入小黄鸭() Application.ScreenUpdating = False For i = 1 To 97 flname = ThisWorkbook.Path & "\frame" & i & ".png" With Sheets.Add .Name = Worksheets.Count Set rg1 = .Range("e3") .Shapes.AddPicture flname, True, True, rg1.Left, rg1.Top, rg1.Width * 4, rg1.Height * 20 插入图片 End With Next Application.ScreenUpdating = True End Sub

小黄鸭关键帧图片（有软件可以切割出来）

●利用API ShellExecute函数打开背景音乐文件

Sub 小黄鸭动起来() ShellExecute 0, "open", ThisWorkbook.Path & "\1.wav", vbNullString, vbNullString, SW_SHOWMINNOACTIVE 最后一个参数是隐藏音乐播放器 Dim Savetime As Double For im = 1 To 3 For num = 98 To 2 Step -1 Savetime = timeGetTime 记下开始时的时间 While timeGetTime < Savetime + 55 循环等待 DoEvents 转让控制权，以便让操作系统处理其它的事件 Wend ThisWorkbook.Worksheets(num).Activate Next Next End Sub

●API函数语句，照抄

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _ (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _ ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Private Declare Function timeGetTime Lib "winmm.dll" () As Long

其中有延迟循环的一部分代码，目的是不让循环过快，看不到中间过程。

odayvba）

=推荐文章=

别在只会录制宏了，今天就教你进阶

【精心整理】操作Txt全过程

【经验】快速学习VBA