Excel笔记：摘录一些有趣的VBA代码

以下皆为我平时在学习的过程中从网络多方收集到的一些比较有趣的VBA代码，拿来即用。但请注意，在使用或分享的过程中，请大家切记做个讲武德的好孩子，切勿用来在别人的电脑，尤其是工作和学习的电脑上搞恶作剧，否则由此带来的一切损失，后果自负，警此。

一、动态时钟

1. 该段代码来源于网络(百度搜索引擎返回的信息检索结果)。可结合Excel中的today(),now()和text()函数，以及自定义格式，编写、设置出各种显示格式的动态电子时钟(最小跨度为秒)。

Sub 哈佛在等我呢()ActiveSheet.Range("A8888").Value = TimeApplication.OnTime Time + TimeSerial(0, 0, 1), "哈佛在等我呢"End Sub

2. 这段代码是在我的微信好友VBA高手"熊猫侠"的帮助下，基于上一段代码改良而来的。上一段代码在运行前，若不把其它Microsoft Office Excel工作簿关闭掉，则可能会影响到其它工作表与工作簿信息的准确性，甚至在强制中断该代码运行进程之前，关闭其它工作簿的操作会失效。

'Option Explicit'Public Time As Date'Sub 哈佛在等我呢()'ThisWorkbook.ActiveSheet.Calculate'Time = Now + TimeValue("00:00:1")'Application.OnTime Time, "哈佛在等我呢"'End Sub

二、返回目录

该代码来源于我一学妹分享的袁竹平工作笔记。设置好起始值为2，并且添加好"开发工具"菜单下的相关控件，之后，不管从首页之外的哪一页任意点击，均可将工作簿从最后一页到顺数第2页(目录首页相邻的那一页)依次折叠起来，并返回到工作簿目录首页。这过程类似收折扇的视觉效果，颇有几分逼格。

Public Sub 返回目录()
Dim X As ByteSheet1.Visible = TrueFor X = 2 To Sheets.CountSheets(X).Visible = 2NextEnd Sub

三、显示所有工作表

同上，皆为袁竹平作品。但功能与上述"返回"目录的代码恰恰相反。若两者结合起来使用，界面视觉效果更为壮观。

Public Sub 显示所有工作表()Dim X As ByteSheet1.Visible = TrueFor X = 2 To Sheets.CountSheets(X).Visible = 1Next
End Sub

四、会说话的表格

该代码来源于我要自学网曾贤志的《 Excel VBA 2013视频教程》。该代码的引用单元格区域可以任意改变，点击运行后，则会有一个比较机械的女声对该区域内单元格的内容逐一进行毫无感情的大声朗读。

Sub 朗读()[a1:a9].SpeakEnd Sub

五、定时关闭电脑

该代码来源于袁竹平作品。平时我们通常是通过手工来关闭电脑，也可以使用某些封装好的小工具，或优酷、酷狗这类客户端进行任务结束后执行电脑关机的操作，或者也可以使用Python脚本来对电脑作进程控制，同理，我们亦可使用VBA来完成这一任务。

Option ExplicitSub TimingOff()    Shell ("at 20:09 Shutdown.exe -s")End Sub

六、关不掉的工作簿

来源于袁竹平作品。添加上该段VBA代码之后，再设置好禁止访问VBA代码事件，则无论对方(除非遇到会暴力破解的高手，或对方让电脑强制关机/重启，否则该加了VBA的Excel工作簿是关不掉的)怎么费尽脑筋，都不能通过正常渠道来正常关闭当前工作簿。

Option ExplicitDim WbClose As BooleanPrivate Sub Workbook_BeforeClose(Cancel As Boolean)    If WbClose = False Then        Cancel = True        MsgBox "请使用""关闭""按钮关闭工作簿!", 48, "提示"    End IfEnd SubPublic Sub CloseWb()    WbClose = True    ThisWorkbook.CloseEnd Sub

七、实用的Excel技巧

1. Excel比率可视化

https://www.bilibili.com/video/BV1NU4y1d7EZ?spm_id_from=333.999.0.0

2. 怎么制作可筛选的Excel折线图