Access2000快餐第二部分(共十一章)

3． 消息框

我们在运行很多（几乎是所有）Windows程序时，会发现这些程序的界面非常友好。友好的人机界面会大大提高用户对程序的好感，使程序变得易用、更容易被接受。一个程序如果有一个好的界面，那么它就成功了一半。同样的，我们用VBA也可以实现良好的人机界面。其中很重要的就是消息框。消息框可以在程序运行中告诉用户下一步该做什么、不该做什么，以及那里除了错误，该如何处理等。消息框就是程序员同用户的对话。那么，下面我们来学习如何利用消息同用户对话。

首先，我们新建一个窗体，上面放上三个控件：文本框“txt姓名”、文本框“txt性别”和命令按钮“com加入”。在窗体模块中写入以下代码：

Option Compare Database

Private Sub com加入_Click()

'声明Name、Sex变量，分别表示姓名，性别

Dim Name As Variant, Sex As Variant

'声明消息框函数将要用到的3个变量，分别代表消息内容、消息框标题和消息常数

Dim Msg, Title, Response

Name = Me.txt姓名 '将“txt姓名”文本框的值赋给变量

Sex = Me.txt性别 '将“txt性别”文本框的值赋给变量

'如果“txt姓名”没有键入值，则弹出错误消息框

If IsNull(Name) = True Then

Beep '发出“嘟”的警告声

Msg = "“姓名”不能为空！" ' 定义信息。

Style = vbOKOnly ' 定义按钮。

Title = "输入错误" ' 定义标题。

Response = MsgBox(Msg, , Title)

End If

'如果“txt性别”没有键入值，则弹出错误消息框

If IsNull(Sex) = True Then

Beep '发出“嘟”的警告声

Msg = "“性别”不能为空！" ' 定义信息。

Style = vbOKOnly ' 定义按钮。

Title = "输入错误" ' 定义标题。

Response = MsgBox(Msg, , Title)

'如果“txt性别”键入值不是“男”或“女”，则弹出错误消息框

ElseIf Sex <> "男" Or Sex <> "女" Then

Beep '发出“嘟”的警告声

Msg = "“性别”只能“男”或“女”！" ' 定义信息。

Style = vbOKOnly ' 定义按钮。

Title = "输入错误" ' 定义标题。

Response = MsgBox(Msg, , Title)

End If

End Sub

程序中用到了MsgBox()函数，这是VBA自带的。其格式如下：

MsgBox(消息[, 命令个数及形式] [, 标题文字] [, 帮助文件, 帮助文件号])

上面的参数除“消息”是必须的，其它都是可选的。默认的“命令个数及形式”是“确定”按钮。当中间若干个参数不写时，“，”不可缺少。上面例子值指定了“消息”和“标题文字”两个参数。

运行程序，将会得到类似于下图的结果：

上面程序中，当你未输入姓名、性别时将会弹出消息，通知你输入必要信息。如果你将性别写成“男”或“女”以外的值，将会告诉你输入错误。并发出“嘟”的警告声。可以警告并防止用户进行错误操作。

4． 新建表、删除表

虽然我们可以在设计时间对数据表进行新建和删除等操作，但我们在运行时或程序编译后却不能通过主设计窗体对其进行该动作。但我们有时也许需要经常地进行一些临时表的新建和删除工作，该怎么办呢？这时也需要VBA。

举一个例子。新建一个窗体，放置三个控件：文本框“txt表名”、命令按钮“com新建”和命令按钮“com删除”。我们需要在其中实现表的新建和删除。在窗体模块中写入以下代码：

Option Compare Database

'声明表名称变量

Dim strName As String

Private Sub com删除_Click()

'将文本框“txt表名”的值赋给变量strName

strName = Me.txt表名

On Error GoTo 删除表_Err

’删除名为“strName”的表，“strName”是一个变量

DoCmd.DeleteObject acTable, strName

删除表_Exit:

Exit Sub

删除表_Err:

MsgBox strName & "表不存在或已被删除" '捕获错误并传递消息

Resume 删除表_Exit

End Sub

Private Sub com新建_Click()

'将文本框“txt表名”的值赋给变量strName

strName = Me.txt表名

On Error GoTo 新建表_Err

Dim db As Database '声明数据库变量

Dim tb As New TableDef '声明新表变量

Dim fldName As New Field '声明新字段（姓名）变量

Dim fldSex As New Field '声明新字段（性别）变量

'指定数据库变量为当前数据库变量

Set db = CurrentDb()

'给新表指定名称

tb.Name = strName

'分别定义姓名字段的名称、数据类型

fldName.Name = "姓名"

fldName.Type = dbText

'保存姓名字段到新表

tb.Fields.Append fldName

'分别定义性别字段的名称、数据类型

fldSex.Name = "性别"

'保存性别字段到新表

fldSex.Type = dbText

tb.Fields.Append fldSex

'保存新表到数据库

db.TableDefs.Append tb

新建表_Exit:

Exit Sub

新建表_Err:

MsgBox strName & "表已存在" '如果该表已存在，则提示错误

Resume 新建表_Exit

End Sub

程序运行结果应当如下图：

程序建立的新表应该如下图：

新建该表时，如果该表已存在，则程序会提示并不再新建；删除该表时，如果该表不存在，程序会提示错误。

[NextPage]

5．运行应用程序

在程序中，我们有时需要用到别的已编制好的程序。比如在一个图片管理数据库中我们也许需要用到Windows绘图程序来修改图片,也许还要用到ACDSee来察看图片。我们不可能也不必要来逐个将这些程序开发出来。我们可以利用Shell语句直接运行这些已加工好的成品程序。下面，我们在Access数据库中来调用Windows自带的应用程序——计算器。这在数据库或其他一些事务运用总是很常见的。调用以下过程就可以在Windows9x操作系统中执行计算器程序。

Public Sub jsq()

On Error GoTo Err_计算器

Dim windowMe

windowMe = Shell("C:WINDOWSCALC.EXE", 1)

Exit_计算器:

Exit Sub

Err_计算器:

MsgBox Err.Description

Resume Exit_计算器

End Sub

这个过程代码很少，其中用到了一个Shell（）函数。该函数的语法为：

Shell(pathname[,windowstyle])

Pathname时必须的参数。它指明要运行的程序。可以在其中指定程序的完整路径。本过程中，计算器程序的路径是"C:WINDOWSCALC.EXE"。windowstyle是可选的参数。表示在程序运行时的窗口样式。其中，1表示窗口具有焦点；3表示窗口具有焦点且最大化。

6．报表画线

Access一个很令人激动的功能——就是它的报表功能。就它的报表功能来说，是笔者在所有的数据库系统中所见到的最棒的一个！注入著名的FOXPRO、C++、PB等都不如Access的报表来的方便和强大。

但在使用Access的报表时，它所提供的控件（文本框和标签等）的边框样式属性出现了一点小小的问题——它所画出来的线条对不齐！这对于注重报表的用户来说是无法忍受的。还好，我们有VBA,它可以为我们解决一切。

如果我们需要得到完美的报表，首先我们要在报表设计视图中将所有的可见控件排列整齐。然后在报表模块中写入画线代码。比如我们要在一个报表中用代码画表头和主体节。可以键入以下代码：

Option Compare Database

'打印报表主体节

Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer)

Me.ScaleMode = 7 '指定页面上坐标的度量单位。

Dim i '声明主体节高度

i = 0.538

'利用Line语句逐条画线

Line (0, i)-(17.019, i)

Line (0, 0)-(0, i)

Line (1.8, 0)-(1.8, i)

Line (3.81, 0)-(3.81, i)

Line (4.868, 0)-(4.868, i)

Line (6.815, 0)-(6.815, i)

Line (8.571, 0)-(8.571, i)

Line (9.82, 0)-(9.82, i)

Line (11.28, 0)-(11.28, i)

Line (12.677, 0)-(12.677, i)

Line (14.053, 0)-(14.053, i)

Line (15.365, 0)-(15.365, i)

Line (17.019, 0)-(17.019, i)

End Sub

'表头打印事件

Private Sub PageHeader_Print(Cancel As Integer, PrintCount As Integer)

Me.ScaleMode = 7

Dim i, j

i = 3.097: j = 1.799

Line (0, j)-(17.019, j)

Line (0, i)-(17.019, i)

Line (0, j)-(0, i)

Line (1.8, j)-(1.8, i)

Line (3.81, j)-(3.81, i)

Line (4.868, j)-(4.868, i)

Line (6.815, j)-(6.815, i)

Line (8.571, j)-(8.571, i)

Line (9.82, j)-(9.82, i)

Line (11.28, j)-(11.28, i)

Line (12.677, j)-(12.677, i)

Line (14.053, j)-(14.053, i)

Line (15.365, j)-(15.365, i)

Line (17.019, j)-(17.019, i)

End Sub

上面过程中的Line是常用的画线语句。其语法格式为：

Line [[Step](x1, y1)] – [Step](x2, y2)[, [color][, B[F]]]

其中，Step是可选的，表示起始点坐标是相对于当前图形位置的一个关键字。(x1, y1) 和(x2, y2)分别指线段的起点坐标和终点坐标。[color]是颜色参数， B表示相对于对角坐标画一个矩形。[F]是指矩形的填充色。

运行结果应当类似于下图（数据会因为数据源的不同而不同）：

现在看一看，报表是不是美观多呢？！

7．捕获错误

只要是一个稍大的足有使用价值的程序，就可能有错误。一个经验丰富的程序员也难免遇到几条可爱的“虫虫”。所以有程序员说，世界上没有一个程序完全没有BUG。有些错误，可以在编程是通过调试加以解决。但有些错误是不可预见的。其实，一个专业的程序，可能会有1/3到1/2的代码是错误处理的。很简单的，一个为编译的程序，当它遇到错误是，会停止程序，弹出一个或错处对话框并调出相应代码要求改正。而一个编译过的程序则会立即结束并回到操作系统！对于程序员可能没什么问题。但是对于一个用户来说，无疑是灾难性的。

要实现错误捕获，可使用On Error语句。其格式为：

On Error {GoTo 行ID|Resume[Next]|GoTo 0}

使用GoTo行ID语句可以在过程中建立一个代码块来处理各种错误。行ID可以是行号或标号。在错误处理语句中，可以检查内部的Err变量来确定错误的真正本质。可以使用Error函数来检验与错误相关的错误消息文本。如果使用带有行号的语句，则可以使用内部的Erl函数来确定引起错误的语句行号。在采取了正确的操作之后，使用Resume语句可以尝试重新执行引起错误的语句。使用Resume Next语句可以继续执行紧接在错误语句后面的语句。我们也可以用Exit Runction或Exit Sub语句来重新设置错误条件，并返回到调用的过程。

使用Resume Next 语句可以捕获错误，但却跳过了引起错误的任一语句。可以在推测会引起错误的语句的下一句调用Err函数，来查看是否有错误产生。如果没有错误产生，Err将返回0。

使用GoTo 0 语句可以关闭当前过程的错误捕获。如果有错误发生，VBA会将错误传送到调用过程中的错误处理程序上或者，如果前面没有错误处理程序，则打开一个错误对话框。

下面的例子将打开一个文本文件：

Sub openErr()

'打开一个d盘根目录下的名为myName的文本文件

Open "d:myName.txt" For Input As #1

...'过程语句

Close #1

End Sub

如果不存在"d:myName.txt"文件，则停止程序运行并会出现以下错误对话框：

我们在上面这段代码中加入错误处理：

Sub openErr()

Dim fileName As String

fileName = "d:myName.txt"

On Error GoTo 无文件

'打开一个d盘根目录下的名为myName的文本文件

Open fileName For Input As #1

'...'过程语句

Close #1

无文件:

' 显示错误信息。

MsgBox "没有文件" & fileName

' 错误语句后继续执行的语句。

Resume Next

End Sub

上面程序运行将会弹出一个出错信息，但并不结束程序，而是继续运行下面的部分。如下图：

8．替代时间控件的Timer

你是否见过某些程序的“定时”功能呢？在VB中有一个Timer控件可以实现该功能，但VBA并未提供这类控件，我们是否就要放弃这一令人感兴趣的功能呢？令人欣慰的是，VBA提供了一个Timer事件来弥补这一功能。

举一个例子，新建一个窗体，放置一个图片控件，嵌入图片“C:WINDOWS

Option Compare Database

Sub Form_Load()

Me.TimerInterval = 1000

End Sub

'发生Timer事件

Sub Form_Timer()

Static intShowPicture As Integer

If intShowPicture Then

' 显示图标。

Me!btnPicture.Picture = "C:WINDOWS

Else

' 不显示图标。

Me!btnPicture.Picture = ""

End If

'重值变量，这一句很重要

intShowPicture = Not intShowPicture

End Sub

其运行结果如下：

图中的图片将每隔1秒钟闪烁一次。怎么样，很酷吧！

[NextPage]

（七） 技巧篇

1.让VBA自己写代码

你有没有觉得一行一行的写代码很烦呢？如果你是一个天生不爱敲键盘的人，那么就让ACCESS自己写代码好了!而且这些代码顶刮刮的专业级！要是不相信，往下看吧：

如果你要写一段打开特定窗体的代码。可以先新建一个宏。如下图。选择“OpenForm”操作，选择窗体名称为“系统主窗体”。保存该宏为“myOpen”。

选择“工具”菜单，“宏”选项。单击“将宏转换Visual Basic为代码”。此时会弹出对话框，选择“给生成的函数加入错误处理”、“包含宏注释’。单击“转换”。转换完毕后，在主视图“模块”项目中可以找到刚刚生成的代码模块：被转换的宏 —myOpen。代码如下：

Option Compare Database

' myOpen

Function myOpen()

On Error GoTo myOpen_Err

' 此操作打开系统主窗体

DoCmd.openform "系统主窗体", acNormal, "", "", , acNormal

myOpen_Exit:

Exit Function

myOpen_Err:

MsgBox Error$

Resume myOpen_Exit

End Function

该函数可以在程序的任何地方被引用。更重要的是，你可以将该代码稍加修改，变成带参数的函数：

Option Compare Database

' myOpen

Public Function myOpen(formName As String) '声明窗体名变量为formName

On Error GoTo myOpen_Err

DoCmd.openform formName, acNormal, "", "", , acNormal

myOpen_Exit:

Exit Function

myOpen_Err:

MsgBox Error$

Resume myOpen_Exit

End Function

该函数可以在程序的任何地方被引用，并可以接受参数。打开任何指定的窗体，并有错误处理程序。这一点，是宏所无法做到的。宏转换为VBA的方法在提高我们编程的效率和正确率的同时，我们可用这种方法来学习VBA的很多语句，以及规范的语法。

3.定制自己的菜单

绝大部分Windows应用程序（几乎是所有的）都有自己的菜单。你想不想在自己的应用程序中加入个性化的菜单呢？其实在ACCESS中定制菜单是一件相当轻松而惬意的事。下面的例子教你如何从菜单运行计算器程序。

下面是调用计算器的函数：

Public Sub jsq()

On Error GoTo Err_计算器

Dim windowMe

windowMe = Shell("C:WINDOWSCALC.EXE", 1)

Exit_计算器:

Exit Sub

Err_计算器:

MsgBox Err.Description

Resume Exit_计算器

End Sub

我们可以通过以下步骤建立一个新菜单：

1． 单击“工具”菜单栏中的“自定义”菜单，在“自定义”对话框中，单击“命令”选项卡。

2．在“类别”框中，单击“文件”。

3．将所需的命令从“命令”框中拖到菜单栏、工具栏上，或者拖到“快捷菜单”工具栏上的适当分类中。当菜单显示菜单命令列表（新菜单是空框）时，指向需要显示命令的位置，然后释放鼠标。

4． 持“自定义”对话框处于打开状态，在菜单命令上单击鼠标右键，然后在快捷菜单上，在“命名”框键入命令的新名称。

5． 在相同的快捷菜单上，单击“属性”项。

6． 在“所在操作”框中，键入所要执行的函数名称，格式为 =functionname()。例如，对于名为 SetCaption() 的自定义函数，键入 =SetCaption()。对于内置函数，则键入函数的名称和其他所需的参数，如 =MsgBox(IIf(Instr(Time(), "PM"), "Good Afternoon", "Good Morning"))。本函数名为“jsq()”，所以键入=jsq()。如图：

现在，你就可以从菜单中找到“计算器”项，可以像操作其它菜单一样来操作它。要注意的是，所在操作只能接受函数，如果是过程，请将其关键字Sub 改为Function。

4.找不到库或引用

有时候，我们在编写代码时，会弹出一条消息：找不到库或引用。我们仔细检查代码，完全没有任何问题！那我们该怎么办呢？

出现这种问题，是因为我们引用了不存在的对象！在安装了某些应用程序（如VB,Office等）之后，也可能会改变原来所设的引用，从而出现错误。其解决方法是：

进入模块或类模块视图，单击菜单“工具”，选择“引用”。弹出如下图所示窗口，找到“错误”或“丢失”的项目，勾掉该项目前的复选框，单击“确定”。重新运行程序，一切搞定。

一般来说，引用的项目只限于要用到的引用，过多的引用会影响程序的编译时间，时程序运行变慢。

[NextPage]

(八） 提高篇

1.注册表编程

你熟悉注册表吗？你有用过注册表吗? 系统注册表其实是一个包含有关计算机运行方式的信息的庞大的数据库。大多数Windows应用程序在安装或运行时，会将某些信息，如安装路径、反安装程序路径及各种设置的信息保存在注册表中。在需要时读取。 VBA提供了以下两个语句和两个函数来专门访问Windows注册表。VBA提供了一个标准的注册位置以存储创建于VBA应用程序的程序信息：HKEY_CURRENT_USER Software VB and VBA Program Settings appname section key。

SaveSetting语句用来保存或创建注册表设置值。如果由于某种原因不能保存关键字设定，则产生一个错误信息。

GetSetting函数用来检索注册表设置值。

GetAllSettings函数用来返回一个包含多项注册表设置的数组。

DeleteSetting语句用来删除注册表设置值。

我们下面来看一个例子。它将用到上面的SaveSetting语句、GetSetting函数和DeleteSetting语句。

新建一个窗口。放置一个名为“复选0”的复选框、两个命令按钮，分别名为“com确定”和“com取消”。“确定”命令将复选框的值写入注册表，“取消”命令删除注册表值。窗体加载时，检索注册表，如果有该项键值，则成为复选框的当前值。

在窗体模块中写入以下代码：

Option Compare Database

'声明一个布尔型变量，存储复选框的值

Dim sz As Boolean

Private Sub Form_Load()

'遇到错误就执行下一句

On Error Resume Next

'重注册表中读取键值，没有则略过

sz = GetSetting("一个例子", "用户设置", "回到上一次操作环境")

'将读取到的值赋给复选框0

Me.复选0 = sz

End Sub

Private Sub 复选0_Click()

'将复选框的值赋给变量

sz = Me.复选0

'将该值存储到指定的注册位置

SaveSetting "一个例子", "用户设置", "回到上一次操作环境", sz

End Sub

Private Sub com取消_Click()

'遇到错误就执行下一句

On Error Resume Next

'删除整个注册位置

DeleteSetting ("一个例子")

End Sub

其运行结果如下图：

打开注册表，应该类似下图：

这样，该设置值就被记录到注册表，即使程序关闭了该值也不会丢失，可随时调用，并可在窗体中方遍地更改

2． 调用API函数

通过在 VBA应用程序中声明外部过程，能够访问 Windows API （以及其它的外部 DLL）。在声明了过程之后，调用它的方法与VBA 自己的过程相同。

最常用的外部过程是组成 Microsoft Windows 自身的过程。Windows API 中包含了成千上万的函数、例程、类型和常数定义，在 VBA 工程中可以声明并使用它们。但是，这些过程是用 C 语言编写的，在 VBA 中使用它们之前必须先进行声明。DLL 过程的声明是比较复杂的。尽管也可以自己进行声明转换，最简单的办法是使用 VBA 专门提供的预定义 Windows API 声明。

那么API函数能做什么呢？由于其功能涉及的内容过于庞大，我们这里只介绍其常用的一个方面。在上面所讲的调用计算器的函数过程中你有没有发现一个问题：就是你运行一次程序就打开一个计算器窗口——虽然你只需要一个就够了！我们能不能设置一个值，只要计算器窗口是打开的，就使该值为一特定的值，如True;此时，不管运行函数多少次，也不打开新窗口——却使已打开的计算器窗口获得焦点！？这对于VBA本身来说有些困难，但通过调用API函数却是易如反掌！这需要用到FindWindow 函数。FindWindow 函数寻找窗口列表中第一个符合指定条件的顶级窗口（FindWindow最常见的一个用途是获得ThunderRTMain类的隐藏窗口的句柄；获得句柄后，可用API函数GetWindowText取得这个窗口的名称；该名也是应用程序的标题）。 由于该函数不是API内置的，所以要对该函数进行预定义的声明。改写计算器函数如下：

Option Compare Database

'声明API函数，捕获窗口句柄

Private Declare Function FindWindow Lib "user32" Alias _

"FindWindowA" (ByVal lpClassName As String, _

ByVal lpWindowName As String) As Long

'运行计算器程序函数

Function jsq()

Dim winhwnd As Long

Dim retval As Long

'检测指定的应用程序是否打开，如果未打开则打开该应用程序，否则激活该程序。

winhwnd = FindWindow(vbNullString, "计算器")

If winhwnd = 0 Then

retval = Shell("C:WINDOWSCALC.EXE", 1)

'retval = PostMessage(winhwnd, &H10, 0&, 0&)

If retval = 0 Then

'打开动作出错，未打开指定的应用程序

MsgBox "打开计算器出错"

End If

Else

AppActivate ("计算器") '激活一指定的应用程序窗口

End If

End Function

运行该函数。你会发现，打开“计算器”以后，再一次运行该函数，“计算器”只是被激活，并不会再一次被打开。用此方法，可使程序更贴近用户的需要。

下面图1是未用API函数捕获句柄的，它打开了多个“计算器”窗口。图2使用API函数捕获句柄的，它始终只打开一个“计算器”窗口。

（图1）

（图2）