如何写VBA代码，实现展开或折叠二级任务的行

干勇平

求助，如何写VBA代码，实现展开或折叠二级任务的行。

如附件，在B列设置了字体Webdings格式，通过向右三角和向下三角，实现展开或折叠二级任务的行的效果
在标题行，实现对所有二级任务的批量展开或折叠行。
感谢路过高人，用小花酬谢帮助者。


第2个附件是3级的示例。

清风竹-

请看附件。

蓝桥玄霜

模块1代码：在表上做一个按钮，把代码赋给按钮

工作表代码：

干勇平

清风竹- 发表于 2022-12-3 15:53
请看附件。

你辛苦写的这个，完全好用极了。谢谢高手。弱弱追问下，如果还有三级，想实现点二级，折叠本二级下的三级，这种效果，我应该如何修改一下代码。

干勇平

清风竹- 发表于 2022-12-3 15:53
请看附件。

有个小知识点请教，比如我选中16整行，弹出提示，运行时错误 '13' 类型不匹配，如何修改呢

干勇平

蓝桥玄霜 发表于 2022-12-3 17:39
模块1代码：在表上做一个按钮，把代码赋给按钮

工作表代码：

谢谢您的帮助，我录入你的代码后，可以运行。但有个小困扰，在表中插入一行后，点击折叠或展示，会少折展一行。有时还提示超出下标。然后，模块1那个，表中插入按钮，指向模块1后，这个按钮运行不了。看能不能解答一下，感谢。我把录入的附件上传哈。
哎呀，附件上传不了，超出大小了

清风竹-

干勇平 发表于 2022-12-4 11:00
你辛苦写的这个，完全好用极了。谢谢高手。弱弱追问下，如果还有三级，想实现点二级，折叠本二级下的三级 ...

关于三级如何修改代码。请先将文件发上来，看看表格有什么变化。才能有的放矢。

清风竹-

干勇平 发表于 2022-12-4 11:07
有个小知识点请教，比如我选中16整行，弹出提示，运行时错误 '13' 类型不匹配，如何修改呢

在第三行加：On Error Resume Next

干勇平

清风竹- 发表于 2022-12-4 14:03
关于三级如何修改代码。请先将文件发上来，看看表格有什么变化。才能有的放矢。

在单位遇的直接上司看完又，提了三级。我无语，再求助你。如果麻烦不好改你就不用理会。谢谢了。
3级的附件上传在一楼了。

干勇平

清风竹- 发表于 2022-12-4 14:05
在第三行加：On Error Resume Next

果然，在第3行   Dim rng As Range后面加上这句，就不会弹出错误提示了。高手啊，谢谢。我赶紧买本VBA宝典啃啃。