VBA代码片段

1.累计求和的代码片段,首先输入要加到的数值,比方说输入100,那么结果就会求出1+2+3+…..+100的结果
Sub addnum()                          
Dim num As Integer                        '定义要输入的整数num
Dim num_sum As Integer              '定义累加和变量num_sum
num_sum = 0                            
num = InputBox("请输入用于求累加和的整数", "数据输入")       
num_sum = compute_sum(num)
Debug.Print num_sum                     '打印计算结果
End Sub
Function compute_sum(num As Integer)
Dim i As Integer                         '定义循环变量i
Dim sum As Integer                  '定义累加变量sum
sum = 0
For i = 1 To num
sum = sum + i
Next i
compute_sum = sum
End Function

2.输出X值,Y值,输出文本,弹出信息框msgbox
Sub com()
Dim y As Integer
Dim x As Integer
x = 10
y = 100
Debug.Print "x=" & x
Debug.Print "y=" & y
Debug.Print "小马哥你好"
End Sub
MsgBox ("小鬼")
Dim a%,b!     '定义了一个整数a,和一个单精度实数b
Dim a(10) as integer    '定义了一个10个存储空间的整形数组a(0)到a(9)
Dim a(1 to 10) as integer    '定义了一个10个存储空间的整形数组a(1)到a(10)
A(2)=4   '数组赋值
Dim a(1 to 4,2 to 3) as integer   '定义了一个二维数组分别是:a(1,2),a(2,2),a(3,2),a(4,2)    a(1,3),a(2,3),a(3,3),a(4,3) 
Public x as integer   '定义了一个全局变量
Static x as integer           '定义了一个静态变量
Call subtone     '调用子函数subtone

3.随机产生一个1-100的数
Sub shiyan()
Dim a As Integer
a = Int(101 * Rnd + 1)
Debug.Print "a=" & a
End Sub

4.输出当前日期
Sub shiyan()
Dim a As Date
a = Date
Debug.Print "a=" & a
 End Sub

5.输出当前时间
Sub shiyan()
Dim a As Date
a = Time()
Debug.Print "a=" & a
End Sub

6.连着一起输出当前日期和时间
Sub shi()
Dim a As Date
a = Now()
Debug.Print "a=" & a
End Sub

7.if语句使用
Sub pro()
If Hour(Time()) >= 0 Then
Debug.Print "晚上好"
End If
End Sub

8.if else语句使用
Sub pro()
If Hour(Time()) >= 18 Then
Debug.Print "晚上好"
Else
Debug.Print "上午好"
End If
End Sub

9.选择语句
Sub pro()
Select Case Hour(Time())
Case 0,1,2                                       '如果是0,1,2点的话,就输出 上午好
Debug.Print "上午好"
Case 8 To 11                           '如果是8点到11点的话,输出 上午好
Debug.Print "上午好"
Case 12 To 17                        '如果是12点到17点,输出下午好
Debug.Print "下午好“"
Case Else                                '否则的话输出下次光临
Debug.Print "欢迎下次光临"
End Select
End Sub

10.QQ登录窗口,登录按钮代码
Private Sub Command8_Click()
If Len(Nz(Me!user)) = 0 And Len(Nz(Me!password)) = 0 Then
MsgBox "用户名,密码不能为空,请重新输入", vbCritical, "error"
Me!user.SetFocus
ElseIf Len(Nz(Me!user)) = 0 Then
MsgBox "用户名为空,请输入", vbCritical, "错误"
Me!user.SetFocus
ElseIf Len(Nz(Me!password)) = 0 Then MsgBox "密码为空,请输入", vbCritical, "错误"
Me!password.SetFocus
Else
If Me!user = "小冲哥" Then
   If UCase(Me!password) = "123" Then
   MsgBox "欢迎使用", vbInformation, "成功"
   Else
   MsgBox "密码错误,请退出", vbCritical, "警告"
   DoCmd.Close
 End If
 Else
 MsgBox "用户名有误，请重新输入", vbCritical, "警告"
DoCmd.Close
End If
End If
End Sub

11.QQ登录窗口,退出按钮代码
Private Sub Command9_Click()
DoCmd.Close
End Sub

12.QQ登录窗口,只有三次输入机会的代码
Private Sub Command8_Click()
Static count As Integer
count = count + 1
If Len(Nz(Me!user)) = 0 And Len(Nz(Me!password)) = 0 And count <= 3 Then
MsgBox "用户名和密码不能为空!请输入" + Chr(13) + Chr(13) + "您还有" & 3 - count & "次机会", vbCritical, "提示"
Me!user.SetFocus
ElseIf Len(Nz(Me!user)) = 0 And count <= 3 Then
MsgBox "用户名不能为空!请输入" + Chr(13) + Chr(13) + "您还有" & 3 - count & "次机会", vbCritical, "提示"
Me!user.SetFocus
ElseIf Len(Nz(Me!password)) = 0 And count <= 3 Then
MsgBox "密码不能为空!请输入" + Chr(13) + Chr(13) + "您还有" & 3 - count & "次机会", vbCritical, "提示"
Me!password.SetFocus
End If
End Sub

13.FOR循环每次减2(从10到1每次减少2个)
Sub gui()
Dim s, i
s = 0
For i = 10 To 1 Step -2        ‘从10到1每次减少2个
 s = s + i
Next i
Debug.Print s
End Sub

14.在窗口中显示由(*)组成的5*5的正方形
Sub prog2()
Const MAX = 5
Dim str As String
str = ""
For n = 1 To MAX
str = str + "*"
Next n
For n = 1 To MAX
Debug.Print str
Next n
End Sub

14.Msgbox函数
Sub prog2()
a = MsgBox("小冲哥", 1, "大家好")
End Sub
Sub prog2()
a = MsgBox("小冲哥", 5 + 16, "大家好") 
End Sub

15.inputbox函数
Sub prog2()
a = InputBox("提示信息", "标题", "默认信息", 100, 100)
Me!getchar.setfoucs  ‘getchar名称的文本框获得焦点
Me!getchar.Value = Val(a) * 12   ‘先将输入的文本转变成数值
End Sub                     ’getchar名称的文本框显示的数值在输入的数值上乘以12

16.账号和密码登录代码(完整做个人信息系统的代码案例)
Private Sub Command登录_Click()
 If 账号ID <> "" And 密码 <> "" Then
   If Me.密码 = DLookup("密码", "用户信息", "账号ID='" & Me.账号ID & "'") Then
   MsgBox "登录成功"
   user_id = Me.账号ID
DoCmd.Close acForm, Me.Name
DoCmd.OpenForm "系统导航", acNormal
Else
  MsgBox "账号或密码错误"
End If
Else
MsgBox "请输入账号和密码"
End If
End Sub

17.用户注册按钮代码以及添加记录,注册失败或者添加失败提醒
Private Sub Command注册_Click()
On Error GoTo 注册失败错误
'.................................判断输人的信息
If 账号ID = "" Or IsNull(账号ID) = True Then
MsgBox "账号ID值为空!"
Exit Sub
Else
    If DCount("密码", "用户信息", "账号ID='" & Me.账号ID & "'") > 0 Then
   MsgBox "该账号ID已注册!"
   Exit Sub
   End If
End If
If 姓名 = "" Or IsNull(姓名) = True Then
MsgBox "姓名值为空！"
Exit Sub
End If
If 性别 = "" Or IsNull(性别) = True Then
MsgBox "性别为空！"
Exit Sub
End If
If 出生日期 = "" Or IsNull(出生日期) = True Then
MsgBox "出生日期为空！"
Exit Sub
End If
If 身份证号 = "" Or IsNull(身份证号) = True Then
MsgBox "身份证号为空！"
Exit Sub
End If
If 籍贯 = "" Or IsNull(籍贯) = True Then
MsgBox "籍贯为空！"
Exit Sub
End If
If 联系电话 = "" Or IsNull(联系电话) = True Then
MsgBox "联系电话为空！"
Exit Sub
End If
If 电子邮箱 = "" Or IsNull(电子邮箱) = True Then
MsgBox "电子邮箱为空！"
Exit Sub
End If
If 密码 = "" Or IsNull(密码) = True Then
MsgBox "密码为空！"
Exit Sub
End If
‘...........................................................................................................添加记录
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("用户信息", dbOpenTable)
With add_rs
.AddNew
!账号ID.Value = 账号ID.Value
!姓名.Value = 姓名.Value
!性别.Value = 性别.Value
!出生日期.Value = 出生日期.Value
!身份证号.Value = 身份证号.Value
!籍贯.Value = 籍贯.Value
!联系电话.Value = 联系电话.Value
!电子邮箱.Value = 电子邮箱.Value
!密码.Value = 密码.Value
.Update
.Close
End With
Set add_rs = Nothing
MsgBox "注册成功！"
DoCmd.Close acForm, Me.Name         ‘注册成功后关闭注册窗口
Exit Sub
‘.................................................................................注册失败提示
注册失败错误:
MsgBox "注册失败!"
End Sub

18导航系统页面的亲友管理按钮代码(打开窗体):
‘首先要建立一个公共变量Public user_id As String
Private Sub Command亲友管理_Click()
DoCmd.OpenForm "亲友信息管理", acNormal, "账号ID='" & user_id & "'" 
End Sub

19.窗体数据更新前提醒代码
Private Sub Form_BeforeUpdate(Cancel As Integer)
'......................数据更新前提醒
On Error GoTo 数据更新前提醒_Err
If (MsgBox("是否保存对记的修改", 1, "修改记示提醒") = 1) Then
      If Me.账号ID <> user_id Then
         MsgBox "账号ID不能修改"
          Exit Sub
          End If
       Beep
        MsgBox "记录修改成功", vbOKOnly, "提醒"
      Else
      DoCmd.RunCommand acCndUndo
      End If
数据更新前提醒_exit:
Exit Sub
数据更新前提醒_Err:
MsgBox Error$
Resume 数据更新前提醒_exit
End Sub

20.亲友姓名数据更新前确认账号ID与用户ID或者窗口加载里设置相等
Private Sub 亲友姓名_BeforeUpdate(Cancel As Integer)
Me.账号ID = user_id
End Sub
Private Sub Form_Load()
Me.账号ID = user_id
Me.成绩ID = Nz(DMax("成绩ID", "课程成绩"), 0) + 1
End Sub

21导航系统页面的通信录按钮代码(打开报表或者标签)代码
Private Sub Command通信录_Click()
DoCmd.OpenReport "亲友通信录", acViewReport, "账号ID='" & user_id & "'"
End Sub

22.按字段进行筛选查询的筛选按钮代码:
Private Sub Command17_Click()
On Error GoTo 结束查询
If 查询内容 <> "" And IsNull(查询内容) = False And 查询字段 <> "" And IsNull(查询字段) = False Then
    Dim search_field As String
    search_field = Me.查询字段
    Dim search_filter As String
    If Me.查询字段 = "课程名称" Or Me.查询字段 = "学期" Then
    search_filter = search_field & "='" & Me.查询内容 & "' and 账号ID='" & user_id & " '"
    End If
    If Me.查询字段 = "绩点" Or Me.查询字段 = "分教" Then
    search_filter = search_field & "='" & Me.查询内容 & "' and 账号ID='" & user_id & " '"
    End If
Me.Filter = search_filter
Me.FilterOn = True
Else
Me.Filter = "账号ID='" & user_id & "'"
Me.FilterOn = True
End If
结束查询:
End Sub

23.窗体关闭的时候执行窗体的数据更新操作代码
Private Sub Form_Close()
Forms("课程成绩列表").Requery
End Sub