1、1、编一个 VBA 程序，将Word 当前文档中光标右边的大写字母转换为小写字母。Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtendn= Asc(Selection.Text)If n = 65 And n ActiveCell.Address ThenActiveCell.Value = a.Valuea.Value = vEnd IfNextEnd Sub12、编写程序，在打开Excel时提示密码输入，如果错误则使用 Application.Quit退出 Excel。Sub auto_Open() If App
2、lication.InputBox(“请输入密码: “) = 123 Then Exit Sub Else Application.Quit End If End Sub13、编写一段程序，求某门课程的平均分。要求用 InputBox函数输入学生的人数和每个人的分数，用 MsgBox语句输出平均分。Sub pjf()rs = InputBox(“输入学生的人数：“) zf = 0For k = 1 To rsf = InputBox(“输入考试成绩“ & k)zf=zf+f Next MsgBox (rs & “位学生的平均分是：“ & zf / rs)End Sub14、设计一个判断三角形是
3、否为直角三角形的子程序，它带有三个整型参数 a、b 和 c分别表示三角形的三条边。Sub cag(a As Integer, b As Integer, c As Integer)If a 2 + b 2 = c 2 Or a 2 + c 2 = b 2 Or b 2 + c 2 = a 2 ThenMsgBox “是直角三角形“ElseMsgbox “不是直角三角形“End IfEnd Sub15、要想在 Excel工作簿打开时建立一个名为“功能”的工具栏，在工具栏上添加一个按钮（按钮的 capition任意，要执行的过程名任意） ，并且让工具栏可见。请写出工作簿Open事件的子程序。Pri
4、vate Sub Workbook_Open()Settbar= Application.CommandBars.Add(Name:=“功能“)Setbutt=tbar.Controls.Add(Type:=msoControlButton)With butt.Caption = “取字模“.Style= msoButtonCaption.OnAction = “qzm“End Withtbar.Visible = TrueEnd Sub16、编写一个子程序，使用工作表函数求出“Sheet1”工作表 A1:D10区域中的最小值。Sub aa()Dim myR As RangeSetmyR=Wo
5、rksheets(“Sheet1“).Range(“A1:D10“)b=Application.WorksheetFunction.Min(myR)MsgBox bEnd Sub17、编写一个子程序，将Excel当前工作表“A1:H8”区域的每行填涂一种不同颜色。Sub kk()For i = 1 To 8For j = Asc(“A“) To Asc(“H“)c = Chr(j) & iRange(c).Interior.ColorIndex = iNext jNext iEnd Sub18、假设 Excel当前工作表是某个班级学生成绩单（50人） ，第一列是姓名，第二、三、四列是三科成绩，
6、试编一段 VBA程序，通过输入框输入姓名后，查询并显示该学生的三科成绩和总成绩。xm = InputBox(“请输入姓名：“)For I = 1 To 50If Range(“A“ & I) = xm Thencj1 = Range(“B“ & I)cj2 = Range(“C“ & I)cj3 = Range(“D“ & I)zcj = cj1 + cj2 + cj3MsgBox “该生成绩分别为：“ & cj1 & cj2 & cj3 & “ 总成绩为：“ & zcj End IfNext19、编写一段程序，在Excel工作簿中添加一个叫“选择模板”的工具栏，在工具栏上添加两个按纽叫“开始
7、”和“退出”并分别调用 KS、TC 两个子程序。Settbar=Application.CommandBars.Add(Name:=“选择模板“)Set butt1 = tbar.Controls.AddWith butt1.Caption = “开始“.OnAction = “ks“End WithSet butt2 = tbar.Controls.AddWith butt2.Caption = “退出“.OnAction = “tc“End Withtbar.Visible = True20、编写一个求斐波那契数列第 n项值的递归函数。该数列为：1 1 2 3 5 8 13 21。Func
8、tion fib(n)If n = 1 Or n=2 Thenfib = 1Elsefib = fib(n - 1) + fib(n - 2)End IfEnd Function21、编写一个子程序，在Excel当前工作表的 F5到 J28填入 1到 5之间的随机整数。Sub mnsj()For i = 5 To 28For j = 6 To 10Cells(i,j) = Int(Rnd * 5) + 1NextNextEnd Sub22、编写一个子程序，当工作簿中工作表被切换时，对工具栏中按钮的可用性进行控制。要求当前工作表为“总分”或“信息”时，使工具栏按钮“butt1”不可用，否则可用。
9、PrivateSubWorkbook_SheetActivate(ByVal Sh As Object)If Sh.Name = “ 总分“ Or Sh.Name = “信息“ ThenButt1.Enabled = FalseElseButt1.Enabled = TrueEnd IfEnd Sub23、在工作簿打开时，首先显示封面窗体 UserForm1，然后建立一个工具栏命名为“竞赛评分” ，在工具栏上添加一个命令按钮“汇总” ，为按钮指定17号图符，并指定要执行的过程为“hz” 。Private Sub Workbook_Open()UserForm1.ShowSettbar=Appl
10、ication.CommandBars.Add(Name:=“竞赛评分“)Setbutt=tbar.Controls.Add(Type:=msoControlButton)With butt.Caption = “汇总“.FaceId = 17.Style=msoButtonIconAndCaption.OnAction = “hz“End WithEnd Sub24、编写一个子程序，将当前 Word文档选中的文本所有单词“ABC”替换为“VBA” 。Sub cz()With Selection.Find.Text = “ABC“.Replacement.Text = “VBA“.Execut
11、e Replace:=wdReplaceAllEnd WithEnd Sub25、编写一个子程序，求Range(“A2:A20”)区域中数据的平均值，填入 Cells（2，3）中。要求四舍五入，保留小数点后两位。Sub 平均值()zf = 0For i = 2 To 20zf = zf + Cells(i, 1)Next iCells(2, 3).Value = Int(zf / 19 * 100 + 0.5) / 100End Sub26、编写一个子程序，求Range(“A2:A20”)区域中数据的最大值和最小值（假设数据的范围在 0到 100之间） ，并用消息框的形式显示出来。Sub dx
12、z()Set myr = Range(“a2:a20“)a=Application.WorksheetFunction.Min(myr)b=Application.WorksheetFunction.Max(myr)MsgBox “最大值为:“ & b & Chr(10) & “最小值为:“ & aEnd Sub27、已知工作表中第 1列从第1行开始到第 40行有 40个考试成绩数据，试编写一个子程序求出最高分并用消息框显示出来。Sub zg()zgf = Range(“A1“)For i = 1 To 40If Range(“A“ & i) zgf Thenzgf = Range(“A“ &
13、 i)End IfNextMsgBox “最高分是:“ & zgfEnd Sub28、已知当前工作表“A1:A60”区域是某考查课成绩，试编写一个子程序求出“良好”人数并将“良好”单元格填充上颜色。Sub gs()k = 0For h = 1 To 60If Cells(h, 1) = “良好“ Then Cells(h,1).Interior.ColorIndex = 5k = k + 1End IfNextMsgBox “良好的人数:“ & kEnd Sub29、已知当前工作表第 1列有 1000个无规则的数据，有的单元格为空，有的单元格里前几个字符是空格。试编写一程序删除空单元格，将单元
14、格内容前面的空格去掉，最后计算有多少个非空单元格。k = 1000For i = 1 To 1000Range(“A“ & i) = Trim(Range(“A“ & i)If Range(“A“ & i) = “ ThenRange(“A“ & i).Deletek = k - 1End IfNext30、编写一段程序，将 Excel当前工作簿“Sheet1”第一行的内容按原位置粘贴到“Sheet2”中Worksheets(“Sheet1“).Rows(1).Copy Worksheets(“Sheet2“).Rows(1)31、设计一个子程序，找出100800 范围内所有能同时被3和 8整
15、除的自然数，依次填写到当前工作表的第一列。Sub 方法 1()i = 1For n = 100 To 800If (n Mod 3 = 0) And (n Mod 8 = 0) ThenCells(i, 1).Value = ni = i + 1End IfNext nEnd Sub32、编写一个子程序，任意输入两个正整数，求它们的最大公约Sub aa()m = InputBox(“请输入第一个正整数“)n = InputBox(“请输入第二个正整数“)If n m Then t = m: m = n: n = tDop = m Mod nm = nn = pLoop While p 5 Th
16、enj = 1ElseIf y = 5 Thenq = Mid(x, p - 1, 1)If q Mod 2 = 0 Thenj = 0Elsej = 1End IfElsej = 0End Ifx = Left(x, p - 1)x = Val(x) + jsslr = x / 1000End Function34、单元格 A1内容为字符串“月、2 月、3 月.10月、11 月、12 月”，请用 vba实现把“月”删除，将单元格 A1内容变为“1、2、3.10、11、12”A1=Application.WorksheetFunction.Substitute(A1, “月“, “)35、在工
17、作表 sheet2中使用 Worksheet_Activate()事件，实现单击 Sheet2时，在 Sheet1的 A列的最后一个记录的下一行自动填上“End” 。PrivateSubWorksheet_Activate()dim i as integeri= Sheets(“Sheet1“).Cells(1, 1).CurrentRegion.Rows.CountSheets(“Sheet1“).Cells(i + 1, 1) = “End“End Sub36、编写程序，在打开 Excel表格时提示输入密码，共有三次机会，三次错误后退出应用程序。Sub auto_Open()If Appl
18、ication.InputBox(“请输入操作权限密码:“, “系统登陆“) = 123 ThenElseMsgBox “密码错误,请重输“, vbCritical + vbOKOnly, “你还有两次机会“If Application.InputBox(“请输入操作权限密码:“, “系统登陆“) = 123 ThenElseMsgBox “密码错误,再给你一次机会!“, vbCritical + vbOKOnly, “你还有一次机会“If Application.InputBox(“请输入操作权限密码:“) = 123 ThenElseMsgBox “你无权进入本系统! “, vbCriti
19、cal + vbOKOnly, “你没有机会啦!“Application.QuitEnd IfEnd IfEnd IfEnd Sub37、Excel 中列号用字母表示，列号 9，对应的字母应该是“I“,列号 27，对应的字母应该是“AA“。用 vba编写一个函数，将列号转变为对应的字母。 （最大列号为 256）FunctionColumnLetter(ColumnNumber As Integer) As StringIf ColumnNumber 256 ThenMsgBox “无效列号“Exit FunctionElseIf ColumnNumber 26 ThenColumnLetter
20、=Chr(Int(ColumnNumber - 1) / 26) + 64) & _Chr(ColumnNumber - 1) Mod 26) + 65)ElseColumnLetter=Chr(ColumnNumber + 64)End IfEnd Function38、简单描述并编程实现下列过程：在打开一个主文件“main.doc”的同时，相关的其他三个文件自动打开“test.doc”、 “answer.doc”及“chart.doc” 。进入 VBE环境，用“工程资源管理器”选择“main”工程，在该工程的“Microsoft Word”对象中双击“This Document”，对 Do
21、cument对象的 Open事件编写如下代码：PrivateSub Document_Open()Documents.Open FileName:=“test.doc“Documents.Open FileName:=“answer.doc“Documents.Open FileName:=“chart.doc“End Sub39、编程实现在文档的末尾插入该文档每次被打开的时间。在用户打开文档时发生该事件。PrivateSub Document_Open()Dim rngCurrent As RangeSetrngCurrent= ActiveDocument.ContentWith rngC
22、urrent.collapse wdCollapseEnd.InsertDateTime”MM/dd/yy HH:MM:SS”,FalseEnd with SetrngCurrent= ActiveDocument.ContentWith rngCurrent.InsertParagraphAfter.Collapse wdCollapseEnd.SelectEnd with End Sub40、编程序，将八进制正整数组成的字符串转换为十进制整数。Sub kk()b = InputBox(“请输入一个八进制数：“)n = Len(b)s = 0For i = 1 To nk = Mid(b,
23、i, 1)s = s * 8 + kNextMsgBox sEnd Sub41、编写一个循环程序，计：s=1+12+123+1234+12345+.。项目数通过键盘指定。Sub kk()n = InputBox(“n=?“)s = 0: t = 0For i = 1 To nt = t * 10 + is = s + tNextMsgBox sEnd Sub0170 06F342、编写程序检查一个字符串是否为回文，是回文时，输出“yes!”，否则输出“no!” 。所谓回文即正向与反向的拼写都一样，例如：adgda。Sub kk()s = InputBox(“请输入一个字符串：“)n = Len
24、(s)p1 = 1: p2 = nDo While p1 Mid(s, p2, 1) ThenMsgBox “No!“Exit SubEnd Ifp1 = p1 + 1p2 = p2 - 1 LoopMsgBox “Yes!“End Sub42、编程将 Excel当前工作表第 1行的所有数据元素逆置。Sub kk()i = 1j=Rows(1).End(xlToRight).ColumnDo While i 1 And i = “0“ And a Max ThenMax = Cells(Row, col)End If NextIf Row = 1 ThenMin = MaxElseIf Max
25、 0 Thenn1 = Val(tt)n2 = Val(Mid(tt, p + 1)k = n2 - n1 + 1Elsek = 0p = InStr(tt, “A“)Do While p 0k = k + 1p = InStr(p + 1, tt, “A“) Loop End IfMsgBox i & “行 “ & j & “列单元格有“ & k & “个“A” 。“NextNext58、在 Word当前文档中，显示 Fibonacci（斐波那契）数列的前 30项。Sub 递推方法()f1 = 1f2 = 1Selection.TypeText Text:=f1 & “ “ & f2 & “
26、 “For N = 3 To 30f3 = f1 + f2Selection.TypeText Text:=f3 & “ “f1 = f2f2 = f3NextEnd Sub59、五只猴子分一堆桃子。第一只猴子把桃子均分成五份后，发现多一个，它吃掉这个桃子，并拿走了其中的一份。第二只猴子把剩余的桃子均分成五0189Sub 方法 1()n = 6Dos=n k=0 For m = 4 To 1 Step -1 s = (s / 4) * 5 + 1If Int(s) = s Then k = k + 1 Nextn = n + 5 Loop Until k = 4MsgBox (“至少应该有“
27、& s & “个桃子！“)End Sub60、在 Word中，用 VBA程序在一定范围内验证哥德巴赫猜想：任何一个大于 5的偶数，可以表示为两个素数之和。Sub out_e()n = 6Doj = 2DoIf isprime(j) And isprime(n - j) ThenSelection.TypeText Text:=n & “=“ & j & “+“ & n - j & Chr(10)Selection.EndKeyUnit:=wdStoryExit Do End Ifj = j + 1 Loopn = n + 2 LoopEnd SubFunction isprime(n)For
28、k = 2 To Sqr(n)If n Mod k = 0 Thenisprime = FalseExit Function End IfNextisprime = TrueEnd Function61、编写一个能随机产生算术运算符（+、-、*、/）的函数。Public Function ysf() x = Int(Rnd() * 4)Select Case xCase 0ysf = “+“Case 1ysf = “-“Case 2ysf = “*“Case 3ysf = “/“End Select End Function61、公鸡每支 5 元，母鸡3 元，小鸡 3 支 1 元。用 100
29、元买 100 只鸡，问公鸡、母鸡、小鸡各多少只？For x = 0 To 19For y = 0 To 33z = 100 - x - yIf 5 * x + 3 * y + z / 3 = 100 Theng = g & “公鸡“ & x & “,母鸡“ & y & “,小鸡“ & z & Chr(10)End IfNext Next MsgBox (g)62、编写一个 VBA程序，分解出给定整数的所有因子并输出。k = InputBox(“请输一整数：“) g = k & “=“ & Sgn(k)k = Abs(k)For i = 2 To k 2Do While k Mod i = 0g = g & “*“ & ik = k iLoop NextIf k 1 Then g = g & “*“ &kMsgBox g
