VB小程序代码

1. 打印负数并分别计算正负数只和： 有如下10个数： -2，73，82，-76，-1，24，321，-25，89，-20(也可以定位其他数值) 打印出其中的每个负数，分别计算并输出正数和负数的和。 程序如下： Sub Form_Click() Dim number AS Integer NegativeSum=0:PostiveSum=0 For i=1 To 10 number=InputBox("Enter data: ") If number<0 Then Print number; NegativeSum=NegativeSum+number Else PostiveSum=PostiveSum+number End If Next i print print "NegativeSum=";NegativeSum Print "PostiveSum=";PostiveSum End Sub 2. 打印九九表： 在窗体上打印九九表： 程序如下： Print Sub Form_Click() FontSize=12 Print Tab(30);"9*9 Table" Print:Print '输出两个空行 Print "* "; For i=1 To 9 Print Tab(i*6);i; '打印横行序号 Next i For j=1 To 9 Print j;" "; '打印竖行序号 For k=1 To j temp=j*k Print Tab(k*6);temp;" "; '打印乘积 Next k Print '输出一个空行 Next j End Sub 3. 打印人员名册 打印人员名册: Private Sub Form_Click() Print:Print FontName="魏碑" FontSize=16 Print "姓名";Tab(8);"年龄";Tab(16);"职务";Tab(24);"单位";Tab(32);"籍贯" Print Print "张得功";Tab(8);"25";Tab(16);"科长";Tab(24);"劳动科";Tab(32);"北京" Print "李德生";Tab(8);"32";Tab(16);"处长";Tab(24);"科研处";Tab(32);"上海" End Sub 4. 单选按钮设置字体类型和大小 单选按钮设置字体类型和大小: 在窗体上画出两个框架，每个框架内分别画两个单选按钮，然后画两个命令按钮和一个文本框。 编写时间过程如下： Ptivate Sub Form_Load() Form1.Caption="框架用法示例" Command1.Caption="确定" Command2.Caption="结束" Frame1.Caption="字体类型" Frame2.Caption="字体大小" Option1.Caption="魏碑" Option2.Caption="幼圆" Option3.Caption="16" Option4.Caption="24" Text1.Text="Visual Basic 程序设计" End Sub Private Sub Command1.Click_() If Optoion1 Then Text1.FontName="魏碑" Else Text1.FontName="幼圆" End IF If Option3 Then Text1.FontSize=16 Else Text1.FontSize=24 End If End Sub Private Sub Command2.Click_() End End Sub 5. 计算存款利息 计算存款利息: 本金p为10000，年利率为0.125，每年计息一次，求10年的本利和是多少。 Sub Form_Click() Dim p As Currency p=10000:r=0.125 t=1 Again If t>10 Then GoTo 100 i=p*r p=p+i t=t+1 GoTo Again 100 Print p End Sub 说明：这里的“Again：”是标号，“100”是行号。 6. 交换两个列表框的项目 交换两个列表框的项目。其中一个列表框的项目按字母升序排列，另一个列表框的项目按项目加入的先后顺序排列。当双击某个项目时，该项目从列表框中消失，并出现在在另一个列表框中： Private Sub Form_Load() List1.FontSize=14 List2.FontSize=14 List1.AddItem "IBM" List1.AddItem "Compad" List1.AddItem "HP" List1.AddItem "FUJI" List1.AddItem "Digital" List1.AddItem "长城" List1.AddItem "联想" List1.AddItem "Canon" List1.AddItem "四通" List1.AddItem "Acer" List1.AddItem "Nec" List1.AddItem "NCR" End Sub Private Sub List1_DbClick() List2.AddItem List1.Text List1.RemoveItem List1.ListIndex End Sub Private Sub List2_DbClick() List1.AddItem List2.Text List2.RemoveItem List2.ListIndex End Sub 7. 交换图片 交换两个图片框中的图形： 在窗体上建立三个图片框Picture1、Picture2、Picture3，其中两个在上，一个在下。 Private Sub Form_Click() '交换位图 Picture3.Picture=Picture1.Picture Picture1.Picture=Picture2.Picture Picture2.Picture=Picture3.Picture '把第三个图片框设置为空 Picture3.Picture=LoadPicture() End Sub Private Sub Form_Load '装入位图 Picture1.Picture=LoadPicture _ ("C:\Documents and Settings\All Users\Documents\My Pictures\1.jpg") '可自行改变路径 Picture2.Picture=LoadPicture _ ("C:\Documents and Settings\All Users\Documents\My Pictures\2.jpd") '可自行改变路径 End Sub 8. 冒泡排序 从键盘上输入10个整数，用冒泡法排序（Bubble Sort）法对这十个数从小到大排序： 在窗体上建立一个命令按钮，并把Caption属性设置为“Click Here to Start” 编写程序如下： Sub Command1_Click() Static number(1 To 10) AS Integer '定义数组number为整形 Msg$="Enter Number for Sort:" MsgStile$="Sort Demo" For i%=1 To 10 number(i%)=InputBox(Msg$,MsgTile$) Next i% For i%=10 To 2 Step -1 For j%=1 To i%-1 If number(j%)=number(j%+1) Then t=number(j%+1) number(j%+1)=number(j%) number(j%)=t End If Next j% Next i% For i%=1 To 10 Print number(i%) Next i% 9. End Sub 10. 判断0~9数据类型--奇数或偶数 判断字母大小写及0~9数据类型--奇数或偶数: Sub Form_Click() Dim Msg,UserInput Msg="Please enter a letter or number from 0 though 9." UserInput=InputBox(Msg) If Len(UserInput)<>0 Then Select Case Asc(UserInput) '返回ASCII码 Case 65 To 90 '大写字母 Msg="You entered the uppercase letter" Msg=Msg&Chr(Asc(UserInput))&"!" Case 97 To 122 '小写字母 Msg="You entered the lowercase letter" Msg=Msg&Chr(Asc(UserInput))&"!" Case Else Msg="You did not enter a letter or a number." End Select Else Select Case CDbl(UserInput) '转换为双精度数值 Case 1,3,5,7,9 Msg=UserInput&"is an odd number" '奇数 Case 0,2,4,6,8 Msg=UserInput&"is an odd number" '偶数 Case Else '出界 Msg="You entered a number ouside" Msg=Msg&"the requested range" End Select End If MsgBox Msg End Sub 11. 判断100~200的所有偶数可以分解为两个素数之和 判断100~200的所有偶数可以分解为两个素数之和。 Function nf(n As Integer) As Boolean '判断n是否为素数 Dim s As Boolean Dim I As Integer s = False For I = 2 To Int(Sqr(n)) '如果能被2 ~Int(Sqr(n))中任何一个数整除,则不是素数,跳出For循环 If n Mod I = 0 Then Exit For End If Next I If I > Int(Sqr(n)) Then '如果正常跳出For循环,则I跳出循环For后的值应该是N,所以满足这个条件 s = True '当I是素数时s=true End If nf = s '当I是素数时, nf=true,否则 nf=false End Function Private Sub form_click() Dim t As Boolean Dim q As Boolean Dim I As Integer Dim j As Integer Dim a As Integer For I = 100 To 200 Step 2 For j = 2 To I / 2 'I一定可分解为一个大于它一半的数和小于它一半的数 t = nf(j) '调用Funtion(函数)nf,判断i是否是素数,把nf的值(true或flase)赋值给变量t If t = True Then '如果t是true 就往下执行,否则就执行到 End if(2)后面的next j语句 q = nf(I - j) '调用Funtion(函数)nf,判断i-j是否是素数,把nf的值(true或flase)赋值给变量q If q = True Then '如果q是true(说明i-j是素数) 就往下执行,否则就跳到 End if(1),继续执行j循环 Print j, I - j '当q是true和t是True同时满足时,说明I的确能分解为两个素数,就打出 j 和 I-j 的值 Exit For '跳出j循环,判断下一个偶数 End If '(1) End If '(2) Next j Next I End Sub 12. 判断是否为素数 判断一个整数（>=3）是否为素数： 提示：如果一个（>=3的）整数可以将n被2到√n（n的平方根）之间的所有整数除，如果都除不尽，则n为素数（）质数，否则n为非素数（合数）。 编写程序如下： Sub Form_Click() Dim n As Integer n=InputBox("请输入一个正整数（>=3）:") k=Int(Spr(n)) '取不大于n的平方根的最大整数 i=2 Swit=0 While i<=k And Swit=0 If n Mod i=0 Then Swit=1 Else i=i+1 End If Wend If Swit=0 Then Print n;"是一个素数" Else Print n;"不是素数" End If End Sub 说明：这里的Swit是一个标志变量。Swit=0标志着n未被任何一个正整数整除过；如果被整除过，则Swit=1。 上述程序也可以写成： 用For…….Next语句: Sub Form_Click() Dim I as Integer,N As Integer N=val(InputBox("")) For I=2 to int(Sqr(N)) If N Mod I=0 Then Exit For Next I If I >int(Sqr(N)) Then Print N & "是素数" Else Print N & "不是素数" End If End Sub 用While….Wend循环: Sub Form_Click() Dim I As Integer, N As Integer N = Val(InputBox("")) I = 2 c = Int(Sqr(N)) Do While I <= c If N Mod I = 0 Then Exit Do I = I + 1 '在For以外的 Loop If I > c Then Print N & "是素数" Else Print N & "不是素数" End If End Sub 法2： 一个数n是素数的条件:不能被2 ~ n-1整除 用For…….Next语句 Sub Form_Click() Dim I as Integer,N As Integer N=val(InputBox("")) For I=2 to N-1 If N Mod I=0 Then Exit For '如果能被2 ~ N-1中任何一个数整除,则不是素数,跳出For循环 Next I If I >= N Then'如果正常跳出For循环,则I跳出循环For后的值应该是N,所以满足这个条件 Print N & "是素数" Else Print N & "不是素数" End If End Sub 13. 切换信号灯 模拟交通信号灯的切换： 在窗体上画出3个图像框和两个命令按钮Command1(切换信号)和Command2(结束程序)。三个图像框分别装有红、绿、蓝三的信号标志的图片。 编写如下事件过程： Private Sub Form_Load() Image2.Visible=Flase Image3.Visible=Flase End Sub Private Sub Command1_Click() If Image1.Visible=True Then Image1.Visible=False Image2.Visible=Ture ElseIf Image2.Visible=Ture Then Image2.Visible=False Image3.Visible=True Else Image3.Visible=False Image2.Visible=True End If End Sub Private Sub Commdan2_Click() End End Sub 14. 求N！ 求N的阶乘N！（N为自然数）： 程序如下： Sub Form_Click() Dim N As Integer N=InputBox("enter N:") k=1 For i=1 To N k=k*i Next i Print N;"N!=";k End Sub 该程序也可以写成： Sub Form_Click() Dim N As Integer N=InputBox("enter N:") k=1:m=1 For i=1 To N k=k*i:m=m+1 Next i Print N;"N!=";k End Sub 程序也可以这样写： Private Sub command1_Click() Dim I As Integer, f As Double, n As Integer n = InputBox("输入一个自然数：", "输入提示", "") f = 1 For I = 1 To n Step 1 f = f * I Next I Text1.Text = f End Sub Private Sub Command2_Click() End End Sub 15. 人口达到或超过70亿所需年数 假设目前世界人口约为60亿，如果以每年1.4%的速度增长，多少年后世界人口达到60亿或超过60亿？ 程序如下： Sub Form_Click() Dim p AS Double Dim r AS Single Dim n AS Integer P=6000000000# r=0.014 n=0 Do Until p>=7000000000# p=p*(1+r) n=n+1 Loop Print n;"年后世界人口达到";p End Sub 上述所用是“Do Until……Loop”循环结构。 该程序若改用“Do……Loop Until”循环，则程序为： Sub Form_Click() Dim p AS Double Dim r AS Single Dim n AS Integer P=6000000000# r=0.014 n=0 Do p=p*(1+r) n=n+1 Loop Until p>=7000000000# Print n;"年后世界人口达到";p End Sub 16. 输出100~300之间的所有素数 输出100~300间的所有素数： 程序如下： Sub Form_Click() For n=101 To 300 step 2 k=Int(Spr(n)) '取不大于n的平方根的最大整数 i=2 Swit=0 While i<=k And Swit=0 If n Mod i=0 Then Swit=1 Else i=i+1 End If Wend If Swit=0 Then d=d+1 If d Mod 5=0 Then '输出5个数字后换行 Print n;" "; Print Else Print n;" " End If End If Next n End Sub 17. 水仙花数 Visual Basic 的"水仙花数"实现代码： 说明：水仙花数是指一个 n 位数 ( n≥3 )，它的每个位上的数字的 n 次幂之和等于它本身。（例如：1^3 + 5^3 + 3^3 = 153） 　　三位的水仙花数共有4个：153，370，371，407； 　　四位的水仙花数共有3个：1634，8208，9474； 　　五位的水仙花数共有3个：54748，92727，93084； 　　六位的水仙花数只有1个：548834； 　　七位的水仙花数共有4个：1741725，4210818，9800817，9926315； 　　八位的水仙花数共有3个：24678050，24678051，88593477 　　…… 　　…… 编写如下事件过程： Private Sub Form_Click() Dim a, b, c As Integer 'a(个)b(十)c(百) For a = 0 To 9 For b = 0 To 9 For c = 1 To 9 If a ^ 3 + b ^ 3 + c ^ 3 = a + 10 * b + 100 * c Then MsgBox 100 * c + 10 * b + a '或写成 Print 100 * c + 10 * b + a End If Next c Next b Next a End Sub 18. 添加成员列表（枚举类型）的方法 添加成员列表（枚举类型）可以用Enum语句： 如： Public Enum Workdays Saturday Sunday Monday Tuesday Wednesday Thursday Friday End Enum 在默认情况下，枚举中的第一个常数被初始化为0，其后的常数则初始化为比起前面的常数大1的数值。 上述的枚举中常数Sunday的值为0。 Public Enum Workdays Saturday Sunday=0 Monday Tuesday Wednesday Thursday Friday Invalid=-1 End Enum 该程序的第一个元素Sunday被赋值为0，Saturday为第一个元素，也被赋值为0，Tuesday的值为2。 19. 显示不同形状 在窗体上显示6中不同是形状： Private Sub Form_Click() FontSize=12 CurrentX=350 Print "0"; For i=1 To 5 Shape1(i).Left=Shape1(i-1).Left+1050 Shape1(i).Shape=1 Shape1(i).Visible=True CurrentX=CrrentX+750 Print i; Next i End Sub 20. 写入与清屏 在窗体上画一个文本框，Caption属性为空；再画三个命令按钮，Caption属性分别为“单击此按钮输入”、“清屏”和“结束” 。 双击Command1进入代码窗口，输入以下程序代码： Private Sub Command1_Click() Text1.FontSize=20 Text1.Text="欢迎进入VB世界" End Sub Private Sub Command2_Click() Text1.Text="" End Sub Private Sub Command13_Click() End End Sub 21. 选择机型并显示 从窗体上选择机型，并在立即窗口中显示结果： 在窗体上建立四个标签，Caption属性分别为：“机型”、“CPU主频”、“内存”和“硬盘”；建立四个组合框，Style属性分别为：1、2、2和0；建立两个命令按钮，Caption属性分别为：“确定”和“取消” ，Default属性都是True。 编写如下事件过程： Sub Form_Load() Combol1.AddItem "IBM" Combol1.AddItem "Compad" Combol1.AddItem "方正" Combol1.AddItem "联想" Combol1.AddItem "HP" Combol1.AddItem "Acer" Combol1.AddItem "DEC" Combol2.AddItem "奔腾3 900" Combol2.AddItem "奔腾3 933" Combol2.AddItem "奔腾3 1.0G" Combol2.AddItem "奔腾4 1.2G" Combol2.AddItem "奔腾4 1.5G"、 Combol2.AddItem "奔腾4 1.7G" Combol2.AddItem "奔腾4 2.0G" Combol3.AddItem "64MB" Combol3.AddItem "128MB" Combol3.AddItem "256MB" Combol4.AddItem "10GB" Combol4.AddItem "20GB" Combol4.AddItem "32GB" Combol4.AddItem "32GB" Combol4.AddItem "40GB" Combol4.AddItem "60GB" End Sub Sub Command1_Click() Debug.Print "你所选的机型为：" Debug.Print "机型：";Combo1 Debug.Print "CPU: ";Combo2 Debug.Print "内存";Combo3 Debug.Print "硬盘";Combo4 End Sub Sub Command2_Click() End End Sub 22. 用单选按钮改变字体和字号 用单选按钮改变文本框里的字体和字号： 在窗体上建立一个文本框和三个单选按钮。单选按钮的Caption属性分别为“FontName:Roman”、“FontName:Modern”和“FontName:Courier”;Name属性分别为“Roman”、“Modern”和“Courier”； 文本框的Name属性为“Display”。 编写如下事件过程： Private Sub Courier_Click() Display.FontSize=18 Display.FontName="Couier" End Sub Private Sub Modern_Click() Display.FontSize=20 Display.FontName="Modern" End Sub Private Sub Form_Roman() Display.FontSize=24 Display.FontName="Times New Roman" End Sub 23. 用复选框给文字加下划线和删除线 用复选框控制文本输入是否“加下划线”和“斜体显示”： 建立三个控件：一个文本框和两个复选框，复选框的Caption属性分别为“加下划线”和“斜体显示”。编写如下事件过程： '双击窗体 Private Sub Form_Load() Display.FontSize=20 End Sub '双击文本框 Private Sub Display_Change() '把文本框的Name属性改为Display且字号为20 If UnderOn.Vale=1 Then Display.FontUnderline=True ElseIF ItalicOn.value=True Then Display.FontItalic=True End If End Sub '双击“斜体显示”复选框 Private Sub ItalicOn_Click() '把复选框的Name属性改为ItalicOn If ItalicOn.Value=1 Then Display.FontItalic=True Else Display.FontItalic=False End If End Sub '双击“加下划线”复选框 Private Sub UnderOn_Click() '把复选框的Name属性改为UnderOn If UnderOn.Value=1 Then Display.FontUnderline=True Else Display.FontUnderline=False End If End Sub 24. 在标签上显示时间 在标签Label上显示系统当前时间： 在窗体上画出一个标签和一个计时器 Private Sub Timer1_Timer() Label1.FontName="黑体" Label1.FontSize=36 Label1.Caption=Time$ End Sub 25. 找出100至500之间满足该数等于两个素数之积的所有整数 找出100至500之间满足该数等于两个素数之积的所有整数，显示在列表框: Private Sub Command1_Click() Dim a(500) As long , i As long , j As long , flag As long Dim b() As long , c() As long n = 0 For i = 2 To 500 flag = 0 For j = 2 To i - 1 If i Mod j = 0 Then flag = 1 End If Next j If flag = 0 Then n = n + 1 ReDim Preserve b(n) b(n) = i End If Next i For i = 1 To n For j = 1 To n If b(i) * b(j) > 100 And b(i) * b(j) < 500 Then List1.AddItem b(i) * b(j) & "=" & b(i) & "*" & b(j) End If Next j Next i End Sub 26. 找出程序满足5M+7N=128的两个素数M和N 用VB找出程序满足5M+7N=128的两个素数M和N: Private Sub Command1_Click() Dim m As Integer, n As Integer For m = 1 To 25 For n = 1 To 18 If 5 * m + 7 * n = 128 And s(m) And s(n) Then Text1.Text = "m=" & m & "n=" & n End If Next n Next m End Sub Private Sub Command2_Click() Text1.Text = "" Command1.SetFocus End Sub Private Function s(x) As Boolean Dim i As Integer For i = 2 To Sqr(x) If x Mod i = o Then s = False Else: s = True End If Next i End Function Private Sub Command3_Click() End End Sub 感谢大家支持 以后会有更多的代码上传。