# If…Then 语句应用方案

## 知识概述

### If…Then 语句

If…Then 语句用于判断表达式的值，满足条件时执行其包含的一组语句。

语法：

If <表达式> Then

[语句组]

End If

如果将 If…Then 语句与语句组中的语句写在同一行，则可以省略 End If 语句，语法格式如下：

If <表达式> Then <语句组>

表达式：必要参数。其运算结果为 True 或 False。当以数值表达式或字符串表达式出现时，如果表达式为 Null，则表达式的运算结果视为 False；当以 TypeOf <对象名> Is <对象类型>形式的表达式出现时。其中的对象名是任何对象的引用，而对象类型则是任何有效的对象类型。如果对象名是对象类型所指定的一种对象类型，则表达式为 True，否则为 False。

语句组：可选参数。一条或多条语句，当表达式的值为 True 时执行这些语句。

注意：语句组中多个语句写在同行要用“:”分开。

下例实现的是加法计算。运行程序，单击“计算”按钮将两个文本框（TextBox 控件）内的数值相加。如图 1 所示。

图 1 加法计算

程序代码如下：

Private Sub Command1_Click()

Command1.Caption = "计算"

If IsNumeric(Text1.Text) And IsNumeric(Text2.Text) Then

Text3.Text = CLng(Text1.Text) + CLng(Text2.Text)

End If

End Sub

如果将 If…Then 语句与语句组中语句写在同一行，则实现的程序代码如下：

Private Sub Command1_Click()

Command1.Caption = "计算"

If IsNumeric(Text1.Text) And IsNumeric(Text2.Text) Then Text3.Text = CLng(Text1.Text) + CLng(Text2.Text)

End Sub

说明：IsNumeric函数用于判断返回表达式的运算结果是否为数值型数据。CLng函数用于强制将一个表达式的值转换为Long数据类型。

#### 程序完整代码

Option Explicit

Private Sub Command1_Click()

If IsNumeric(Text1.Text) And IsNumeric(Text2.Text) Then

Text3.Text = CLng(Text1.Text) + CLng(Text2.Text)

End If

End Sub

### If 语句的嵌套

若 If…Then 语句后或 Else 语句后还包含一个或多个完整的、新的 If 类型的语句，这就是 If 语句的嵌套。下面的语句格式是 If 语句嵌套结构之一。

If <表达式> Then

If <表达式> Then

<语句组>

Else

<语句组>

End If

Else

If <表达式> then

<语句组>

Else

<语句组>

End If

End If

在使用 If 嵌套语句时，要注意 Else 语句与 If 之间的匹配关系。一般来说 Else 语句都与上面最近的 If 语句相匹配。而且嵌套时 If 语句的层次性一定要好，不然很容易给代码阅读造成混乱。因此如果能用单个的 If 语句实现的功能，尽量不用嵌套 If 语句。

在判断 TextBox 控件中输入的数值大小时，需要先判断 TextBox 控件中输入的内容是否是数字，然后再判断其大小。如果使用两个 If…Then 语句同时判断，则当 TextBox 控件内输入的不是数字时，将产生运行时错误。因此应当使用 If 语句嵌套语句进行判断。

例如，猜一个 1000 以内的随机数。如图 1 和图 2 所示。

图 1 输入随机数

图 2 比较结果

#### 程序代码如下

Public A As Long

Private Sub Command1_Click()

Randomize

A = CLng(1000 * Rnd) '生成一个随机数

End Sub

Private Sub Command2_Click()

Static B As Long

'判断输入的是否是空值或非数值数据

If Text1.Text <> "" And IsNumeric(Text1.Text) Then

B = B + 1

If CLng(Text1.Text) > A Then '比较大小返回信息

MsgBox "大了。", , "信息提示"

ElseIf CLng(Text1.Text) < A Then

MsgBox "小了。", , "信息提示"

Else

MsgBox "猜对了，这个数是" & A & "。", , "信息提示"

B = 0

End If

End If

Label2.Caption = "这是第" & B & "次。" '记录猜值次数

End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)

If KeyCode = 13 Then Call Command2_Click

End Sub

#### 程序完整代码

Option Explicit

Public A As Long

Private Sub Command1_Click()

Randomize

A = CLng(1000 * Rnd) '生成一个随机数

End Sub

Private Sub Command2_Click()

Static B As Long

If Text1.Text <> "" And IsNumeric(Text1.Text) Then '判断输入的是否是空值或非数值数据

B = B + 1

If CLng(Text1.Text) > A Then '比较大小返回信息

MsgBox "大了。", , "信息提示"

ElseIf CLng(Text1.Text) < A Then

MsgBox "小了。", , "信息提示"

Else

MsgBox "猜对了，这个数是" & A & "。", , "信息提示"

B = 0

End If

End If

Label2.Caption = "这是第" & B & "次。" '记录猜值次数

End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)

If KeyCode = 13 Then Call Command2_Click

End Sub

### 双分支 If…Then…Else…语句

在 If…Then…Else…语句中，可以有若干组语句块，根据实际条件只执行其中的一组，其执行流程如图 1 所示。

图 1 If…Then…Else…语句执行流程图

If…Then…Else…语句也分为单行形式和块形式。

l 单行形式

语法：

If 条件表达式 Then 语句块 1 Else 语句块 2

当条件满足时（即“条件表达式”的值为 True），执行“语句块 1”，否则执行“语句块 2”，然后继续执行 If 语句下面的语句。

例如下面就是一个单行形式的 If…Then…Else…语句：

If Text1.Text = "11" Then MsgBox "登录成功！" Else MsgBox "密码错误，重新输入！"

语句块 2

l 块形式

如果单行形式中的两个语句块中的语句较多，则写在单行不易读，且容易出错，这时就应该使用块形式的 If…Then…Else…语句。

语法：

If 条件表达式 Then

语句块 1

Else

语句块 2

End If

块形式的 If…Then…Else…End If 语句与单行形式的 If…Then…Else…语句功能相同，只是块形式更便于阅读和理解。

另外，块形式中的最后一个 End If 关键字不能省略，它是块形式的结束标志，如果省略会出现编译错误，如图 2 所示。

图 2 省略最后一个 End If 出现错误

下面用块形式判断用户输入的密码，如果“密码”文本框中的值为“11”，则提示用户登录成功，否则提示用户“密码错误，请重新输入！”，代码如下。

Private Sub Command1_Click()

If Text1.Text = "11" Then '判断“密码”文本框中的值是否为“11”

MsgBox "登录成功！", , "提示" '提示登录成功

Else

MsgBox "密码错误，请重新输入！", , "提示" '否则提示密码错误

End If

End Sub

### 多分支 If…Then…ElseIf 语句

只有块形式的写法，语句格式为：

If 条件表达式 1 Then

语句块 1

ElseIf 条件表达式 2 Then

语句块 2

ElseIf 条件表达式 3 Then

语句块 3

…

ElseIf 条件表达式 n Then

语句块 n

…

[Else

语句块 n+1]

End If

该语句的作用是根据不同的条件确定执行哪个语句块，其执行顺序为条件表达式 1、条件表达式 2、……，一旦条件表达式的值为 True，则执行该条件下的语句块。

多分支多分支 If…Then…ElseIf 语句的执行流程如图 1 所示。

图 1 多分支 If…Then…ElseIf 语句执行流程图

在 VB 中该语句中的条件表达式和语句块的个数没有具体限制。另外，书写时应注意，关键字 ElseIf 中间没有空格。

下面通过一个实例，介绍多分支 If 语句的应用。将输入的分数做不同程度的分类，即“优”、“良”、“及格”和“不及格”，先判断分数是否等于 100，再判断是否>=80，是否>=60，……以此类推。程序设计步骤如下。

（1）启动 Visual Basic6.0，新建工程，在新建的 Form1 窗体中添加一个文本框（Text1）、3 个标签（Label1、Label2 和 Label3）和一个命令按钮（Command1）。

（2）在代码窗口中编写如下代码。

Private Sub Command1_Click()

'定义一个整型变量

Dim a As Integer

'给变量 a 赋值

a = Val(Text1.Text)

If a = 100 Then

lblResult.Caption = "优"

ElseIf a >= 80 Then

lblResult.Caption = "良"

ElseIf a >= 60 Then

lblResult.Caption = "及格"

Else

lblResult.Caption = "不及格"

End If

End Sub

（3）按 F5 键，运行工程，在第一个文本框中输入一个整数，单击“判断”按钮，程序会在第二个文本框中显示判断结果，如图 2 所示。

图 2 多分支 If 实例运行效果图

## 应用一：窗体状态栏中显示系统时间

通过 Timer 控件和 Time 函数，在窗体状态栏中显示系统时间，当鼠标移到时间上时，设置 ToolTipText 属性为系统日期，利用 If…Then 语句判断鼠标是否在状态栏上，并用 Format 函数将其格式化为长日期，具体代码如下：

Private Sub Timer1_Timer()

LblTime = Time

End Sub

Private Sub LblTime_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If X < 10350 And Y < 7200 Then

LblTime.ToolTipText = Format(Date, "yyyy 年 m 月 d 日")

End If

End Sub

## 应用二：编码设计

编码设计是管理信息系统过程中的一个重要内容。设计一个好的编码，可以使信息统计和查询变得更方便。

编码一般由数字和字符组成，用来代表事物的实体类别和属性的特定符号或记号。

在稿费发放管理系统中，需要对稿费单进行编码，稿费单序号用来标记稿费单的单号，具有惟一性。通过该编码，可以判断某一张稿费单是哪年、哪一期、第几张单据。在程序中它是这样设计的：

首先，使用 If…Then 语句判断稿费发放表中是否有记录，如果无记录，则说明要录入的稿费单是这一期稿费的第一张单据，该单据编码由字母“M”、用户所选的“年”和“期”，再加“00001”组成，如“M2000300001”；如果有记录，那么该单据编码由字母“M”、用户所选的“年”和“期”，和上一张单据编码的后五位数字加 1 组成（需对编码进行格式化处理），如“M2000300006”；关键代码如下：

rs.Open "select * from 稿费发放表 order by 序号", cnn, adOpenKeyset, adLockOptimistic

If rs.RecordCount > 0 Then

rs.MoveLast

LblNumber.Caption = "M" & DCboYear.Text & DCboP.Text & Format(Val(Right(rs.Fields("序号"), 5)) +1, "00000")

Else

LblNumber.Caption = "M" & DCboYear.Text & DCboP.Text & "00001"

End If

rs.Close

通过以上方法设计的“稿费单序号”，给数据查询带来了极大的方便。例如，在稿费单管理模块中，单击左侧稿费单序号列表中的序号，即可查询该稿费单的详细信息，结果如图 1 所示。

图 1 通过“稿费单序号”查询稿费单信息

## 应用三：系统管理员登录（Main_Administrator 窗体）

系统管理员登录窗体如图 1 所示。

图 1 系统管理员登录窗体

实现代码如下：

Private Sub lblSave_Click()

Dim rs As New ADODB.Recordset

If TxtAdministrator.Text = "" Then

MsgBox "系统不允许【系统管理员】为空！"

Exit Sub

End If

If TxtPassword.Text = "" Then

MsgBox "系统不允许【密码】为空！"

Exit Sub

End If

rs.Open "select * from 系统管理员表", cnn, adOpenKeyset, adLockOptimistic

rs.AddNew

rs.Fields("系统管理员") = TxtAdministrator.Text

rs.Fields("密码") = TxtPassword.Text

rs.Update

MsgBox "数据保存成功！"

End Sub

Private Sub lblCancel_Click()

Frm_Main.Show

Unload Me

End Sub

## 应用四：稿费信息统计

稿费信息统计如图 1 所示。

图 1 稿费信息统计

实现代码如下：

Dim myval As Currency

Private Sub Form_Activate()

Combo1.Text = "刊物名称"

DtpDateS.Value = Date - 10

DtpDateE.Value = Date

MS1.ColWidth(0) = 12 * 25 * 1.15

MS1.ColWidth(1) = 12 * 25 * 8

MS1.ColWidth(2) = 12 * 25 * 6

MS1.ColWidth(3) = 12 * 25 * 8

MS1.ColWidth(4) = 12 * 25 * 8

MS1.ColWidth(5) = 12 * 25 * 8

MS1.ColWidth(6) = 12 * 25 * 8

MS1.ColWidth(7) = 12 * 25 * 8

MS1.ColWidth(8) = 12 * 25 * 8

MS1.ColWidth(9) = 12 * 25 * 8

MS1.TextMatrix(0, 0) = "xh"

myval = 0

If Not Adodc1.Recordset.BOF Then Adodc1.Recordset.MoveFirst

For i = 1 To Adodc1.Recordset.RecordCount

myval = Val(Adodc1.Recordset.Fields("金额")) + myval

MS1.TextMatrix(i, 0) = i

If Not Adodc1.Recordset.EOF Then Adodc1.Recordset.MoveNext

Next i

LblMoney.Caption = Format(myval, "0.00")

LblRecordCount.Caption = Adodc1.Recordset.RecordCount

End Sub

Private Sub Form_Load()

Combo1.AddItem ("刊物名称")

Combo1.AddItem ("年")

Combo1.AddItem ("期")

Combo1.AddItem ("刊物名称, 年")

Combo1.AddItem ("刊物名称, 年, 期")

Combo1.AddItem ("姓名, 刊物名称, 期")

Combo1.AddItem ("姓名, 刊物名称, 年, 期")

Combo1.ListIndex = 0

End Sub

Private Sub CmdStat_Click()

myval = 0

If Check1.Value = 1 And Check2.Value = 1 Then

Adodc1.RecordSource = "select " & Combo1.Text & " ," & "sum(金额)as 稿费汇总 from 稿费发放表 where 日期 between '" + Str(DtpDateS.Value) + "'AND '" + Str(DtpDateE.Value) + "'and 刊物名称 like +'" + DataCombo1.Text + "'group by " & Combo1.Text

Adodc1.Refresh

End If

If Check1.Value = 1 And Check2.Value = 0 Then

Adodc1.RecordSource = "select " & Combo1.Text & " ," & "sum(金额)as 稿费汇总 from 稿费发放表 where 刊物名称 like + '" + DataCombo1.Text + "'group by " & Combo1.Text

Adodc1.Refresh

End If

If Check1.Value = 0 And Check2.Value = 1 Then

Adodc1.RecordSource = "select " & Combo1.Text & " ," & "sum(金额)as 稿费汇总 from 稿费发放表 where 日期 between '" + Str(DtpDateS.Value) + "'AND '" + Str(DtpDateE.Value) + "'group by " & Combo1.Text

Adodc1.Refresh

End If

If Check1.Value = 0 And Check2.Value = 0 Then

Adodc1.RecordSource = "select " & Combo1.Text & " ," & "sum(金额)as 稿费汇总 from 稿费发放表 group by " & Combo1.Text

Adodc1.Refresh

End If

If Not Adodc1.Recordset.EOF Then Adodc1.Recordset.MoveLast

If Not Adodc1.Recordset.BOF Then Adodc1.Recordset.MoveFirst

For i = 1 To Adodc1.Recordset.RecordCount

myval = Val(Adodc1.Recordset.Fields("稿费汇总")) + myval

MS1.TextMatrix(i, 0) = i

If Not Adodc1.Recordset.EOF Then Adodc1.Recordset.MoveNext

Next i

LblMoney.Caption = Format(myval, "0.00")

LblRecordCount.Caption = Adodc1.Recordset.RecordCount

End Sub

Private Sub CmdEnd_Click()

Frm_Main.Show

Unload Me

End Sub

## 应用五：将汉字自动转换为相应的拼音简码

当用户在文本框中输入汉字时，系统将自动生成该汉字的拼音简码。例如，用户输入“明日科技”，系统自动生成拼音简码“mrkj”。

这种自动生成的拼音简码，为以后的数据录入工作带来了极大的方便，它的主要设计思路如下：

1．在标准模块中定义一个 py 函数，其代码如下：

Public Function py(mystr As String) As String

If Asc(mystr) < 0 Then

If Asc(Left(mystr, 1)) < Asc("啊") Then

py = "0"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("啊") And Asc(Left(mystr, 1)) < Asc("芭") Then

py = "A"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("芭") And Asc(Left(mystr, 1)) < Asc("擦") Then

py = "B"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("擦") And Asc(Left(mystr, 1)) < Asc("搭") Then

py = "C"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("搭") And Asc(Left(mystr, 1)) < Asc("蛾") Then

py = "D"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("蛾") And Asc(Left(mystr, 1)) < Asc("发") Then

py = "E"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("发") And Asc(Left(mystr, 1)) < Asc("噶") Then

py = "F"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("噶") And Asc(Left(mystr, 1)) < Asc("哈") Then

py = "G"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("哈") And Asc(Left(mystr, 1)) < Asc("击") Then

py = "H"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("击") And Asc(Left(mystr, 1)) < Asc("喀") Then

py = "J"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("喀") And Asc(Left(mystr, 1)) < Asc("垃") Then

py = "K"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("垃") And Asc(Left(mystr, 1)) < Asc("妈") Then

py = "L"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("妈") And Asc(Left(mystr, 1)) < Asc("拿") Then

py = "M"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("拿") And Asc(Left(mystr, 1)) < Asc("哦") Then

py = "N"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("哦") And Asc(Left(mystr, 1)) < Asc("啪") Then

py = "O"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("啪") And Asc(Left(mystr, 1)) < Asc("期") Then

py = "P"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("期") And Asc(Left(mystr, 1)) < Asc("然") Then

py = "Q"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("然") And Asc(Left(mystr, 1)) < Asc("撒") Then

py = "R"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("撒") And Asc(Left(mystr, 1)) < Asc("塌") Then

py = "S"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("塌") And Asc(Left(mystr, 1)) < Asc("挖") Then

py = "T"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("挖") And Asc(Left(mystr, 1)) < Asc("昔") Then

py = "W"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("昔") And Asc(Left(mystr, 1)) < Asc("压") Then

py = "X"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("压") And Asc(Left(mystr, 1)) < Asc("匝") Then

py = "Y"

Exit Function

End If

If Asc(Left(mystr, 1)) >= Asc("匝") Then

py = "Z"

Exit Function

End If

Else

If UCase(mystr) <= "Z" And UCase(mystr) >= "A" Then

py = UCase(Left(mystr, 1))

Else

py = mystr

End If

End If

End Function

当录入汉字的文本框发生变化时，调用 py 函数将文本框中的汉字逐一转换为拼音简码，其代码如下：

Private Sub Text1_Change(Index As Integer)

Dim a,b As Integer

a = Len(Text1(1).Text)

strPY = ""

For b = 1 To a

strPY = strPY & py(Mid(Text1(1).Text, b, 1))

Next b

End Sub

## 应用六：设置密码

密码设置如图 1 所示。

图 1 密码设置

实现的代码如下：

Private Sub Command1_Click()

Adodc1.RecordSource = "select * from usertb where 名称='" & Text1.Text & "'"

Adodc1.Refresh

If Text1.Text = "" Then

MsgBox "请输入操作员!", , "提示信息"

Text1.SetFocus

Else

On Error Resume Next

If Trim(Text1.Text) <> Adodc1.Recordset.Fields(1) Then

MsgBox "无此操作员，请重新输入!", , "提示信息"

Exit Sub

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

Text1.SetFocus

End If

If Text1.Text <> "" And Text2.Text = "" Then

MsgBox "请输入操作员密码!", , "提示信息"

Text2.SetFocus

Exit Sub

Else

If Text2.Text <> Adodc1.Recordset.Fields(2) Then

MsgBox "原密码错误,请重新输入原密码!", , "提示信息"

Text2.Text = ""

Text2.SetFocus

Exit Sub

End If

End If

If Text3.Text <> "" Then

Adodc1.Recordset.Fields(2) = Text3.Text

MsgBox "密码修改成功,退出密码设置!", , "提示信息"

Adodc1.Recordset.Update

Unload Me

Else

MsgBox "请输入新密码!!", , "提示信息"

End If

End If

End Sub

Private Sub Command2_Click()

Unload Me

End Sub

Private Sub Form_Activate()

Text1.SetFocus

Me.Caption = Me.Caption & " " & frmmain.StatusBar1.Panels(2).Text

End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)

If KeyCode = 13 Then Text2.SetFocus

End Sub

Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)

If KeyCode = 13 Then Text3.SetFocus

End Sub

Private Sub Text3_KeyDown(KeyCode As Integer, Shift As Integer)

If KeyCode = 13 Then

Call Command1_Click

Else

End If

End Sub

## 应用七：应收款管理

应收款管理主要记录收款信息、未收款销售单据的信息查看和累计应收余额的计算，其中使用 AddNew 方法保存收款新数据，使用 Update 方法更新累计余额，在进行更新数据之前要使用 If…Then 语句判断数据是否合理。

#### 1．窗体界面设计

（1）新建一个窗体，设置该窗体的名称为“main_ysyf_charge”；Caption 属性为“应收款管理”；MDIChild 属性为“True”；WindowState 属性为“2-Maximized”。

（2）在窗体上添加 Label、Text 和 Command 控件，其中 Command 控件的默认名分别为“Command1”和“Command2”，如果使按钮显示图片，那么应首先设置 Style 属性为“1-Graphical”，然后再加入需要的图片。

（3）在窗体上添加 ADO 控件、DataCombo 控件和 DataGrid 控件，这些控件的属性设置如图 1 所示。

图 1 应收款管理窗体的设计结果

#### 2．程序代码设计

客户名称变化时，查询该客户的欠款和还款信息，具体代码如下：

Private Sub DataCombo1_Change()

Adodc1.RecordSource = "select * from tb_client_arrearage where 客户名称 like '" + DataCombo1.BoundText + "'+ '%'order by 日期,时间"

Adodc1.Refresh

If Adodc1.Recordset.EOF = False Then Adodc1.Recordset.MoveLast

End Sub

Private Sub Text1_Change()

If DataCombo1.Text <> "" Then

If Val(Text1.Text) > 0 Then

Command1.Enabled = True

Else

Command1.Enabled = False

End If

End If

End Sub

按“客户名称”查询，记录该客户的还款信息，同时更新该客户的欠款累计余额，具体代码如下：

Private Sub Command1_Click() '收款

Adodc1.RecordSource = "select * from tb_client_arrearage where 客户名称 like'" + DataCombo1.BoundText + "'and abs(累计余额) >0) order by 日期,时间"

Adodc1.Refresh

With Adodc1.Recordset

If .RecordCount > 0 Then

If .EOF = False Then .MoveLast

If Abs(Val(.Fields("累计余额"))) > 0 Then gysye.Text = .Fields("累计余额")

End If

Adodc1.RecordSource = "select * from tb_client_arrearage where 客户名称 like '" + DataCombo1.BoundText + "' order by 日期,时间"

Adodc1.Refresh

If .EOF = False Then .MoveLast

.AddNew

.Fields("日期") = Date

.Fields("时间") = Time

If DataCombo1.BoundText <> "" Then .Fields("客户名称") = DataCombo1.BoundText

.Fields("摘要") = "收款:收【" & DataCombo1.BoundText & "】" & Text1.Text & "元"

.Fields("收款合计") = Format(Val(Text1.Text), "0.00")

.Fields("累计余额") = Format((Val(gysye.Text) - Val(Text1.Text)), "0.00")

.Update

End With

gysye.Text = ""

Text1.Text = ""

End Sub

#### 3．完整程序代码

Private Sub DataCombo1_Change()

Adodc1.RecordSource = "select * from tb_client_arrearage where 客户名称 like '" + DataCombo1.BoundText + "'+ '%'order by 日期,时间"

Adodc1.Refresh

If Adodc1.Recordset.EOF = False Then Adodc1.Recordset.MoveLast

End Sub

Private Sub Text1_Change()

If DataCombo1.Text <> "" Then

If Val(Text1.Text) > 0 Then

Command1.Enabled = True

Else

Command1.Enabled = False

End If

End If

End Sub

Private Sub Command1_Click() '收款

Adodc1.RecordSource = "select * from tb_client_arrearage where 客户名称 like'" + DataCombo1.BoundText + "'and abs(累计余额)>0 order by 日期,时间"

Adodc1.Refresh

With Adodc1.Recordset

If .RecordCount > 0 Then

If .EOF = False Then .MoveLast

If Abs(Val(.Fields("累计余额"))) > 0 Then gysye.Text = .Fields("累计余额")

End If

Adodc1.RecordSource = "select * from tb_client_arrearage where 客户名称 like '" + DataCombo1.BoundText + "' order by 日期,时间"

Adodc1.Refresh

If .EOF = False Then .MoveLast

.AddNew

.Fields("日期") = Date

.Fields("时间") = Time

If DataCombo1.BoundText <> "" Then .Fields("客户名称") = DataCombo1.BoundText

.Fields("摘要") = "收款:收【" & DataCombo1.BoundText & "】" & Text1.Text & "元"

.Fields("收款合计") = Format(Val(Text1.Text), "0.00")

.Fields("累计余额") = Format((Val(gysye.Text) - Val(Text1.Text)), "0.00")

.Update

End With

gysye.Text = ""

Text1.Text = ""

End Sub

Private Sub Command2_Click()

Unload Me

End Sub

应收款管理窗体的运行结果如图 2 所示。

图 2 应收款管理窗体的运行结果

## 应用八：权限设置

权限设置如图 1 所示。

图 1 权限设置

实现的代码如下：

Dim i As Integer '定义一个整型变量

Dim rs1 As New ADODB.Recordset '定义一个数据集对象

Dim txtSQL As String '定义一个字符串变量

Private Sub Form_Activate()

For i = 0 To 4 '设置 Check1(i)的值为 1

Check1(i).Value = 1

Next i

'设置窗体标题栏的内容

Me.Caption = Me.Caption & " 操作员： " & frm_main.St1.Panels(3).Text

End Sub

Private Sub Form_Unload(Cancel As Integer)

frm_main.Enabled = True '设置 frm_main 窗体有效

End Sub

Private Sub DataList1_Click()

Text1.Text = Trim(DataList1.BoundText) '赋值给 text1.text

'按操作员名称查询权限信息

txtSQL = "select * from 权限信息表 where 操作员名称='" & Trim(DataList1.BoundText) & "'"

Set rs1 = ESQL(txtSQL) '执行 SQL 语句

If rs1.RecordCount > 0 Then '当记录大于零时

For i = 0 To 4

'当数据库字段值为 0 时，Check1(i)的值为 1，否则 Check1(i)的值为 0

If rs1.Fields(i) = 0 Then Check1(i).Value = 1 Else Check1(i).Value = 0

Next i

rs1.Update '更新记录

End If

End Sub

Private Sub Command1_Click()

For i = 0 To 4 '设置 Check1(i)的值为 1

Check1(i).Value = 1

Next i

End Sub

Private Sub Command2_Click()

For i = 0 To 4 '设置 Check1(i)的值为 0

Check1(i).Value = 0

Next i

End Sub

Private Sub Command3_Click()

If Text1.Text <> "" Then

If DataList1.BoundText <> "" Then

'按操作员名称查询权限信息

txtSQL = "select * from 权限信息表 where 操作员名称='" & DataList1.BoundText & "'"

Set rs1 = ESQL(txtSQL)

If rs1.RecordCount > 0 Then '当记录大于零时

For i = 0 To 4

'当 Check1(i)的值为 1 时，数据库字段值为 0，否则数据库字段值为 1

If Check1(i).Value = 1 Then rs1.Fields(i) = 0 Else rs1.Fields(i) = 1

Next i

rs1.Update '更新记录

End If

End If

MsgBox "设置权限已完成！"

Else

MsgBox "请选择操作员！"

End If

End Sub

Private Sub Command4_Click()

Unload Me

frm_main.Enabled = True

End Sub

## 应用九：根据返回值进行相关的操作

### 实例说明

在编写应用程序的过程中，经常会遇到这样的问题，如，在某控件内部输入数字，查询相应列中的内容。下面的实例介绍如何查询 ComboBox 控件内部的数字。运行程序，在学生信息表中查询学生学号为 ComboBox 控件中所选择的项目（本例中选择 19994101）的学生信息。运行程序，单击“查询”按钮，即可将学号是 19994101 的学生信息显示在下面的表格中，如图 1 所示。

图 1 查询指定控件内数字

### 思路与技术

要实现对指定控件中数字的查询，特别要注意引号的使用。下面，介绍使用控件对数字查询的例子。

利用 If…Then…语句判断指定的数据表中的记录是否存在，如果表中数据存在，再根据指定条件进行下一步的操作。其中：

Combo1 控件指定的学生编号所对应的学生信息。代码如下：

select * from tb_stu where 学生编号=" + Combo1.Text + "

使用%进行模糊查询：

Adodc1.RecordSource = "select * from 销售单 where 数量 like " & "'" & Text1.Text & "%'"

使用_进行模糊查询：

Adodc1.RecordSource = "select * from 销售单 where 数量 like " & "'_" & Text1.Text & "_'"

本例中用到 SQL 语句的关键代码如下：

Adodc1.RecordSource = "select * from tb_stu where 学生编号=" + Combo1.Text + ""

本实例的实现过程如图 2 所示。

图 2 本实例的实现过程

注意：

在查询控件中的数字信息时，要在控件的两端添加连接符“+”或“&”，但不需在两端添加单引号“'”，如 select * from tb_stu where 学生编号=" + Combo1.Text + "。

### 开发步骤

（1）新建一个标准工程，创建一个新窗体，默认名为 Form1。

（2）在窗体上添加两个 Frame 控件。

（3）在 Frame1 上添加两个 OptionButton 控件，两个 ComboBox 控件，两个 CommandButton 控件。

（4）在 Frame2 上添加一个 ADO 控件和一个 DataGrid 控件，由于这两个控件都属于 ActiveX 控件，因此，在使用之前必须把它们从“部件”对话框中添加到工具箱。添加方法如下：

在“工程”→“部件”对话框中勾选 Microsoft ADO Data Control 6.0（SP4）（OLEDB）列表项，以及 Microsoft DataGrid Control 6.0（SP5）（OLEDB）列表项。单击“确定”按钮，即可将 ADO 控件和 DataGrid 控件添加到工具箱中。设置 ADO 控件的 Visible 属性为 False。其中，ADO 控件用于连接数据表，DataGrid 控件用于显示数据信息。

表 1 Form1 窗体中控件部分属性设置

控件名 | 属性 | 值
Adodc | Name | Adodc1
CommandButton | Name Caption | Cmd_Find 查询
CommandButton | Name Caption | Cmd_Refresh 刷新
ComboBox | Name | Combo1
ComboBox | Name | Combo2
DataGrid | Name | DataGrid1
Frame | Name | Frame1
Frame | Name Caption | Frame2 查询结果
OptionButton | Name Caption | Option1 学生姓名
OptionButton | Name Caption | Option2 学生年龄

（5）为 Form1 窗体添加如下代码。

Private Sub Cmd_Find_Click() '【查询】按钮

If Option1.Value = True Then '按学生编号查询

If Combo1.Text = "" Then

Call MyMsg '调用自定义函数，用于信息提示

Else

Adodc1.RecordSource = "select * from tb_stu where 学生编号=" + Combo1.Text + ""

Adodc1.Refresh

Set DataGrid1.DataSource = Adodc1

End If

ElseIf Option2.Value = True Then '按年龄查询

If Combo2.Text = "" Then

Call MyMsg '调用自定义函数，用于信息提示

Else

Adodc1.RecordSource = "select * from tb_stu where 年龄=" + Combo2.Text + ""

Adodc1.Refresh

Set DataGrid1.DataSource = Adodc1

End If

End If

End Sub

Private Sub Cmd_Refresh_Click()

Adodc1.RecordSource = "select * from tb_stu "

Adodc1.Refresh

Set DataGrid1.DataSource = Adodc1

End Sub

Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)

If KeyCode = 13 Then Cmd_Find.SetFocus

End Sub

Private Sub Combo2_DropDown()

If KeyCode = 13 Then Cmd_Find.SetFocus

End Sub

Private Sub Form_Load()

Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db_ExpStu.mdb;Persist Security Info=False"

Adodc1.RecordSource = "select * from tb_stu "

Adodc1.Refresh

Set DataGrid1.DataSource = Adodc1

Call AddData

End Sub

Function MyMsg()

MsgBox "请选择或输入查询条件", , "信息提示"

End Function

Function AddData()

Adodc1.RecordSource = "select * from tb_stu order by 学生编号"

Adodc1.Refresh

If Adodc1.Recordset.RecordCount > 0 Then

Adodc1.Recordset.MoveFirst

For i = 1 To Adodc1.Recordset.RecordCount

Combo1.AddItem Adodc1.Recordset.Fields("学生编号")

Adodc1.Recordset.MoveNext

Next i

End If

Combo1.Text = ""

Adodc1.RecordSource = "select * from tb_stu order by 学生编号"

Adodc1.Refresh

If Adodc1.Recordset.RecordCount > 0 Then

Adodc1.Recordset.MoveFirst

For i = 1 To Adodc1.Recordset.RecordCount

Combo2.AddItem Adodc1.Recordset.Fields("年龄")

Adodc1.Recordset.MoveNext

Next i

End If

Combo2.Text = ""

End Function

Private Sub Option1_Click()

Combo1.Enabled = True

Combo2.Enabled = False

Combo1.ListIndex = 0

Combo2.Text = ""

End Sub

Private Sub Option2_Click()

Combo1.Enabled = False

Combo2.Enabled = True

Combo2.ListIndex = 0

Combo1.Text = ""

End Sub