每日烧脑练习题（宏）

413191246se

* 功能：防止遗忘《社保卡》密码及老年痴呆，锻炼脑力，增强智力。
* 原由：去年办了《社保卡》，费劲想了一个密码，起初经常在《3D图画》程序中复写密码。然而，最近未坚持下来。最近，想到如此异常重要的密码竟然快忘了，非常不适，遂做此宏。
* 感谢：非常感谢 sylun 老师 辛苦编写了本宏的随机出题代码(我查找网络好几天，也不知道怎么随机出题)，这样，广大坛友可以凭此代码自行扩充宏中的 arr 数组内容，编制自己的练习题（在练习时，可以敲小键盘的 Enter回车键；不想练习时按“否”即可）——请注意：如果是 Win10 等 64 位系统，请将代码复制到 Word 中的空白文档中，再全选，剪切，在 VBE 中粘贴即可；否则，汉字可能会变成乱码。

1. Sub aaaa每日烧脑练习题()
   
2. 'code by sylun
   
3.     Dim arr, d, i&, n%
   
4.     arr = Array("你的名字叫什么？", "你的出生年月是多少？", "你今年多大了？", _
   
5.         "你的社保卡密码是多少？", "你家的联系电话是多少？", "你的手机号码是多少？", _
   
6.         "你的身份证号码是多少？", "你的家庭住址是哪里？", _
   
7.         "你的父亲叫什么名字？多大了？", "你的母亲叫什么名字？多大了？")
   
8.     Set d = CreateObject("Scripting.Dictionary")
   
9.     Do
   
10.         Randomize
    
11. 100     n = Int(Rnd * (UBound(arr) + 1))
    
12.         If d.Exists(n) = True Then GoTo 100 Else d.Add n, arr(n)
    
13.         If MsgBox(n + 1 & "#: " & arr(n) & vbCr & vbCr & "——是否继续？", 4 + 64, "每日烧脑练习题") = vbNo Then End
    
14.         i = i + 1
    
15.     Loop Until i = UBound(arr) + 1
    
16.     MsgBox Join(d.items, vbCrLf), vbInformation
    
17. End Sub

复制代码

yongfengchen

围观，同时学习下，楼主烧脑防痴呆的创意还是不错的

sylun

可试试如下修改：

1. Sub test()
   
2.     Dim arr, d, i&, n%
   
3.     arr = Array("你的名字叫什么？", "你今年多大了？", "你的社保卡密码是多少？（提示：6位数字！不要说出来！默念即可。）")
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Do
   
6.         Randomize
   
7. 100     n = Int(Rnd * (UBound(arr) + 1))
   
8.         If d.Exists(n) = True Then GoTo 100 Else d.Add n, arr(n)
   
9.         If MsgBox(n + 1 & "#: " & arr(n) & vbCr & vbCr & "——是否继续？", 4 + 64, "每日烧脑练习题") = vbNo Then End
   
10.         i = i + 1
    
11.     Loop Until i = UBound(arr) + 1
    
12.     MsgBox Join(d.items, vbCrLf), vbInformation
    
13. End Sub

复制代码

413191246se

谢谢老师！问题解决！运行良好！非常高兴！我已将 3 条词条扩充为 10 条。请老师注意休息！新年快乐！

413191246se

* 重新更新了一下词条，使 10 条词条更加有意义！
* 各位如果有需要，可以自行扩充词条，修改 arr 数组即可。
* 如果将此宏宏名放在 AutoExec 自动宏中，则每次启动 Word 即可自动出题。