ACCESS-VBA编程

2025-05-01

ACCESS-VBA编程

ACCESS－VBA编程.

控件：常量控件

acBoundObjectFrame 绑定对象框 acCheckBox 复选框 acComboBox 组合框

acCommandButton 命令按钮

acCustomControl ActiveX（自定义）控件 acImage 图像 acLabel 标签 acLine 线条

acListBox 列表框

acObjectFrame 未绑定对象框或图表 acOptionButton 选项按钮 acOptionGroup 选项组 acPage 页

acPageBreak 分页符 acRectangle 矩形

acSubform 子窗体/子报表 acTabCtl 选项卡 acTextBox 文本框

acToggleButton 切换按钮

在VB中对窗体控件的引用

键入包含控件的窗体或报表的标识符，后面紧接 ! 运算符和控件的名称。例如，下列标识符将引用“订单”窗体上“订单ID”控件值： Forms![订单]![订单ID]

引用子窗体或子报表上的控件，不必使用“窗体”或“报表”属性为窗体或报表指定完整的标识符。例如，可以使用下列标识符来引用“订单”子窗体上的“数量”控件： Forms![订单]![订单子窗体]![数量]

判断窗体或报表中控件的数目，然后将该数目赋给一个变量。 Dim intFormControls As Integer Dim intReportControls As Integer

intFormControls = Forms!Employees.Count

intReportControls = Reports!FreightCharges.Count 设置控件可见性

Dim i, ii As Integer For ii = 3 To 10

Me.Controls.Item(ii).Visible = True Next

For i = 11 To 22

Me.Controls.Item(i).Visible = False Next

按特殊名在VBA中设置控件的可见性： For i = 27 To 47

If Me.Controls.Item(i).Name Like \ Me.Controls.Item(i).Visible = False End If

ACCESS-VBA编程

指定一个控件能否接受焦点 Enabled属性：

me.控件.Enabled = true'能 =false'不能

指定一个控件能否被编辑： locked 如：

me.控件.Locked = true me.控件.Locked = false 设置控件标题显示的文字

Me.控件.Caption = \显示窗体\

设置标签颜色： Me.LabelColor =200

获得焦点及失去焦点时字段变更颜色。

如果你的控件是文本框，名称为“txt字段”，写如下代码：

Private Sub txt字段_GotFocus() Me.txt字段.BackColor = 12632256 End Sub

当中“12632256”是灰色，你可以自己选择希望的颜色，如果想在失去焦点时改为原来的颜色，写如下代码：

Private Sub txt字段_LostFocus() Me.txt字段.BackColor = 16777215 End Sub

使标签闪烁以引人注意

设置窗体的TimerInterval 值为1000 (1秒).

forms OnTimer 加入代码:

Sub Form_Timer()

YourTextLabel.Visible = Not YourTextLabel.Visible End_Sub

设置标签字体颜色： Me.Label1.ForeColor = 设置文本框颜色： Me.TextColor = 300 设置文本框字体颜色： Me.TextFontColor = 500 标签等左边距离：

Me.Label2.Left = 2200

定位控件

Me.控件.Top = 8290 Me. 控件.Left = 100

ACCESS-VBA编程

设置控件宽度/高度

Me.考生答案.Width = 10000 Me.考生答案.Height = 1000 标签等字体粗细：

Me.Label2.FontWeight = 20000 控件边框颜色：

Me.Label2.BorderColor = 0 控件边框线条

BorderStyle 属性使用以下设置：

透明 0 （仅对于标签、图表和子报表而言是默认值）透明的实线 1 （默认值）实线虚线 2 虚线短虚线 3 短虚线点线 4 点线

稀疏点线 5 点距较宽的点线

点划线 6 虚线与点线组合的点划线

点点划线 7 虚线-点线-点线组合的点点划线双实线 8 双实线指定控件的边框宽度

使用 BorderWidth 属性可以指定控件的边框宽度取值：0或1－6 指定控件是否透明

使BackStyle 属性可以指定控件是否透明。 True 、False 解除子窗体锁定

Me.进_子窗体.Locked = False '解除子窗体锁定将窗体上所有控件的输入法关掉! 来源:不祥

Private Sub Form_Open(Cancel As Integer) Dim ctl As Access.Control For Each ctl In Me.Controls

Debug.Print ctl.Name & ctl.ControlType If ctl.ControlType = acTextBox Then ctl.IMEMode = 2 End If Next End Sub

上述代码控制文本框，你还可以控制其他的，只要copy进窗体就可以了列表框的值的引用

如果是单选的列表框，用 me.[列表框名] 来引用；如果要引用不是结合型列的值，可以用 me.[列表框名].column(n) （第一列n=0，第二列n=1?）

引用多列组合框或列表框中特定的列或列与行的组合

用 0 引用第一列，用 1 引用第二列，依此类推。用 0 引用第一行，用 1 引用第二行，依此类推。例如在含有一列客户 ID 和一列客户名称的列表框中，可以使用如下方式引用第二列、第五行的客户名称： Forms!Contacts!Customers.Column(1, 4)

可以使用 Column 属性将组合框或列表框的内容指定给另一控件，如文本框。例如，若要将文本框的 ControlSource 属性设为列表框第二列中的值，可以使用以下表达式： =Forms!Customers!CompanyName.Column(1)

ACCESS-VBA编程

如果引用了组合框或列表框中的列，但用户未做选择，则 Column 属性设置将为 Null。可以使用 IsNull 函数来确定是否进行了选择，示例如下： If IsNull(Forms!Customers!Country) Then MsgBox \End If

显示获得焦点的控件的 Name： ctl As Control

Set ctl = Screen.ActiveControl MsgBox ctl.Name

窗体：

如何让窗体的标题条闪烁以引起用户注意？

在窗体中放一个Timer控件Timer1,设置其Inteval=200 *API函数声明

Private Declare Function FlashWindow Lib \ Long

注释：在窗体中写下如下代码: Private Sub Timer1_Timer() FlashWindow Me.hwnd, True End Sub

窗体上如何使用windows的媒体播放器插入Microsoft Media Player控件

插入控件后，在控件中属性中的几个主要选项： FileName:要播放的文件名，包括路径 AutoStrat:是否自动播放

AutoRevind:播放完后是否自动回到起点

指定当窗体上的命令按钮保持按下状态时，是否重复执行事件过程或宏

使用 AutoRepeat 属性可以指定当窗体上的命令按钮保持按下状态时，是否重复执行事件过程或宏 True 、False

以隐藏方式打开一个窗体 me.visible=false '允许添加

me.AllowAdditions= True '记录不锁定

me.RecordLocks = 1 是否自动居中

AutoCenter= True,False 是否自动调整

AutoResize = True,False

窗体边框样式

me.BorderStyle=1 中译:无其它 1 无 2 细边框 3 可调边框

ACCESS-VBA编程

4 对话框边框

设置窗体、页眉、页脚颜色： Me.Section(0).BackColor = 200 Me.Section(1).BackColor = 200 Me.Section(2).BackColor = 200

窗体标题

me.Caption=\中国ACCESS软件网\中译:窗体标题为\中国ACCESS软件网\不含引号) 关闭按钮

me.CloseButton =True 中译允许关闭按钮其它:true:允许 False:不允许

控制框

me.ControlBox =True 允许其它:true:允许 False:不允许

默认视图

me.DefaultView =0 为单一窗口

其它:0:单一窗口1:连续窗体2:数据表

vba如何獲取/設置在數據表方式下個列的寬度一、Me.RowHeight = 800

二、Me.子窗体名.Form.Controls(\列名\允许分隔线

me.DividingLines =True 中译允许分隔线其它:true:允许 False:不允许允许打印版式

英文:me.LayoutForPrint =True 中译允许打印版式其它:true:允许 False:不允许无最大最小化按钮

英文:me.MinMaxButtons =0 中译无最大最小化按钮其它:0:无 1:最大化 2:最小化 3:两者都有允许浏览按钮

英文:me.NavigationButtons =True 中译允许浏览按钮其它:true:允许 False:不允许

滚动条

me.ScrollBars =0二者均无

其它:0:二者均无 1:只垂直 2:只水平3:二者都有

允许/不允许添加

me.AllowAdditions=True/False 允许/不允许删除

me.AllowDeletions=True/False 允许/不允许编辑

me.AllowEdits=True/False

指定是否允许打开绑定窗体进行数据输入

使用 DataEntry 属性可以指定是否允许打开绑定窗体进行数据输入。DataEntry 属性不决定是否可以添加记

ACCESS-VBA编程

录，只决定是否显示已有的记录。Boolean 型，可读/写。 True 、False

允许/不允许筛选

me.AllowFilters=True/False Filter=\筛选内容\筛选应用与/否筛选

FilterOn=True/False

将 MyForm 窗体的 BackColor 属性，改成 ColorCode 参数指定的色彩。使用 QBColor 函数将 MyForm 窗体的 BackColor 属性，改成 ColorCode 参数指定的色彩。QBColor 可接受 0 到 15 的整型值。

Sub ChangeBackColor (ColorCode As Integer, MyForm As Form) MyForm.BackColor = QBColor(ColorCode) End Sub

窗体真正居中显示

如下代码可以做到真正居中显示

Private Sub Form_Load() DoCmd.Echo False Dim x, y As Integer DoCmd.Maximize x = Me.WindowWidth y = Me.WindowHeight DoCmd.Restore DoCmd.Echo True

Move (x - Me.WindowWidth) / 2, (y - Me.WindowHeight) / 2 End Sub

隐藏窗体[学生名册]数据表视图中的性别字段 Table!学生名册!性别.ColumnHidden = -1

显示获得焦点窗体的 Name 属性设置：

使用 ActiveForm 属性（和 Screen 对象一起）可以标识或引用获得焦点的窗体。 Dim dqhdct As Form

Set dqhdct = Screen.ActiveForm MsgBox dqhdct.Name

判断窗体是否打开的方法

Function IsLoaded(strName As String, Optional intObjectType As Integer = acForm)

IsLoaded = (SysCmd(acSysCmdGetObjectState, intObjectType, strName) <> 0) End Function

使用 IsLoaded 属性可以确定当前是否加载了 AccessObject。Boolean 型，只读。以下是一个示例：

If CurrentProject.AllForms(\Forms!frmMain.Form.Visible = False End If

窗体中组合框不在列表中示例不在列表中事件代码：

Private Sub 名称_NotInList(NewData As String, Response As Integer) Response = acDataErrContinue

ACCESS-VBA编程

If MsgBox(\您输入的名称不在列表中，在列表中添加新记录吗？\银河酒业\

Me![名称] = Null

DoCmd.GoToControl \单价\

DoCmd.OpenForm \酒名列表\ Else

Me![名称] = Null Me![名称].Dropdown End If End Sub

获得焦点事件代码：

Private Sub 名称_GotFocus() Me![名称].Requery End Sub

如何让窗体总在最前面？ *API函数声明

Declare Function SetWindowPos Lib \ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

注释：常量声明

Private Const SWP_NOSIZE = &H1 Private Const SWP_NOMOVE = &H2 Private Const HWND_TOPMOST = -1 Private Const HWND_NOTOPMOST = -2 注释：在某个form里写：

SetWindowPos me.hWnd,WND_TOPMOST,0,0,0,0, SWP_NOMOVE 注释：或下面 SetWindowPos me.hWnd,WND_TOPMOST,0,0,0,0, SWP_NOSIZE 用代码选择图表样式 \柱形图\

Me.graphnow.Object.ChartType = xlColumnClustered \折线图\

Me.graphnow.Object.ChartType = xlLineMarkers \饼形图\

Me.graphnow.Object.ChartType = xl3DPie \条形图\

Me.graphnow.Object.ChartType = xlBarClustered

柱形图簇状柱形图 xlColumnClustered 三维簇状柱形图 xl3DColumnClustered 堆积柱形图 xlColumnStacked

三维堆积柱形图 xl3DColumnStacked 百分比堆积柱形图 xlColumnStacked100

三维百分比堆积柱形图 xl3DColumnStacked100 三维柱形图 xl3DColumn

条形图簇状条形图 xlBarClustered 三维簇状条形图 xl3DBarClustered 堆积条形图 xlBarStacked

三维堆积条形图 xl3DBarStacked 百分比堆积条形图 xlBarStacked100

三维百分比堆积条形图 xl3DBarStacked100

ACCESS-VBA编程

折线图折线图 xlLine

数据点折线图 xlLineMarkers 堆积折线图 xlLineStacked

堆积数据点折线图 xlLineMarkersStacked 堆积百分比折线图 xlLineStacked100

百分比堆积数据点折线图 xlLIneMarkersStacked100 三维折线图 xl3DLine 饼图饼图 xlPie

分离型饼图 xlPieExploded 三维饼图 xl3Dpie

三维分离型饼图 xl3DPieExploded 复合饼图 xlPieOfPie 复合柱饼图 xlBarOfPie

XY (散点图) 散点图 xlXYScatter 平滑线散点图 xlXYScatterSmooth

无数据点平滑线散点图 xlXYScatterSmoothNoMarkers 折线散点图 xlXYScatterLines

无数据点折线散点图 xlXYScatterLinesNoMarkers 气泡图气泡图 xlBubble

三维气泡图 xlBubble3DEffect 面积图面积图 xlArea 三维面积图 xl3DArea

堆积面积图 xlAreaStacked

三维堆积面积图 xl3DAreaStacked 百分比堆积面积图 xlAreaStacked100

三维百分比堆积面积图 xl3DAreaStacked100 圆环图圆环图 xlDoughnut

分离型圆环图 xlDoughnutExploded 雷达图雷达图 xlRadar

数据点雷达图 xlRadarMarkers 填充雷达图 xlRadarFilled 曲面图三维曲面图 xlSurface

曲面图（俯视图） xlSurfaceTopView

三维曲面图（框架图） xlSurfaceWireframe

曲面图（俯视框架图） xlSurfaceTopViewWireframe 股价图盘高-盘低-收盘图 xlStockHLC 成交量-盘高-盘低-收盘图 xlStockVHLC 开盘-盘高-盘低-收盘图 xlStockOHLC

成交量-开盘-盘高-盘低-收盘图 xlStockVOHLC 圆柱图簇状柱形圆柱图 xlCylinderColClustered 簇状条形圆柱图 xlCylinderBarClustered 堆积柱形圆柱图 xlCylinderColStacked 堆积条形圆柱图 xlCylinderBarStacked

百分比堆积柱形圆柱图 xlCylinderColStacked100 百分比堆积条形圆柱图 xlCylinderBarStacked100 三维柱形圆柱图 xlCylinderCol

圆锥图簇状柱形圆锥图 xlConeColClustered 簇状条形圆锥图 xlConeBarClustered 堆积柱形圆锥图 xlConeColStacked 堆积条形圆锥图 xlConeBarStacked

百分比堆积柱形圆锥图 xlConeColStacked100

ACCESS-VBA编程

百分比堆积条形圆锥图 xlConeBarStacked100 三维柱形圆锥图 xlConeCol

棱锥图簇状柱形棱锥图 xlPyramidColClustered 簇状条形棱锥图 xlPyramidBarClustered 堆积柱形棱锥图 xlPyramidColStacked 堆积条形棱锥图 xlPyramidBarStacked

百分比堆积柱形棱锥图 xlPyramidColStacked100 百分比堆积条形棱锥图 xlPyramidBarStacked100 三维堆积柱形棱锥图 Color 属性移动无边框窗体例子模块：

Declare Function SendMessage Lib \Long, ByVal wParam As Long, lParam As Any) As Long

Declare Function ReleaseCapture Lib \Public Const WM_NCLBUTTONDOWN = &HA1 Public Const HTCAPTION = 2

应用：

Private Sub Form_Close()

DoCmd.RunCommand acCmdAppMaximize End Sub

Private Sub Form_Load()

DoCmd.RunCommand acCmdAppMinimize End Sub

Private Sub XPForm_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then ReleaseCapture

SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0& End If End Sub

Private Sub 命令20_Click() DoCmd.Close End Sub

如何移动没有标题栏的窗口？

我们一般是用鼠标按住窗口的标题栏，然后移动窗口，当窗口没有标题栏时，我们可以用下面的方法来移动窗口：

*API函数声明：

Declare Function ReleaseCapture Lib \\Any) As Long

Public Const HTCAPTION = 2

Public Const WM_NCLBUTTONDOWN = &HA1 在 Form_MouseDown 事件中：

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ReleaseCapture SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION,0& End Sub

ACCESS-VBA编程

日期、时间函数

如何将文本型：2003.08.04 转换为日期型：2003-08-04 cdate(replace(\显示当前日期在该年中所处的星期号 =Format(Now(), \ww 为 1 到 53。

显示日期字段值的四位年份值。 =DatePart（\订购日期]）

显示日期字段值前 10 天的日期值。 =DateAdd（\应付日期]）显示日期字段值前一个月的日期值。 =DateAdd(\

显示日期1和日期2之间相差的天数。

=DateDiff（\订购日期], [发货日期]）

从今天算起到三个月后的日期之间的记录。 Betweeb date() and adddate(3,date()) 根据出生日期计算年龄（周岁）

=IIf(Month(Date())-Month([出生年月日])>-1,Year(Date())-Year([出生年月日]),Year(Date())-Year([出生年月日])-1)

自定义日期/时间格式 (Format 函数)

(:) 时间分隔符。在一些区域，可能用其他符号来当时间分隔符。格式化时间值时，时间分隔符可以分隔时、分、秒。时间分隔符的真正字符在格式输出时取决于系统的设置。

(/) 日期分隔符。在一些区域，可能用其他符号来当日期分隔符。格式化日期数值时，日期分隔符可以分隔年、月、日。日期分隔符的真正字符在格式输出时取决于系统设置。

C 以 ddddd 来显示日期并且以 ttttt 来显示时间。如果想显示的数值无小数部分，则只显示日期部分，如果想显示的数值无整数部分，则只显示时间部分。 D

以没有前导零的数字来显示日 (1 – 31)。 Dd

以有前导零的数字来显示日 (01 – 31)。 ddd

以简写来表示日 (Sun –Sat)。 dddd

以全称来表示日 (Sunday –Saturday)。 ddddd

以完整日期表示法显示（包括年、月、日），日期的显示要依系统的短日期格式设置而定。缺省的短日期格式为 m/d/yy。 dddddd

以完整日期表示法显示日期系列数（包括年、月、日），日期的显示要依系统识别的长日期格式而定。缺省的长日期格式为 mmmm dd, yyyy。 aaaa

与dddd 一样，它只是该字符串的本地化版本。 W

将一周中的日期以数值表示（1 表星期日~ 7表星期六）。 ww

将一年中的星期以数值表示 (1 – 54)。 M

以没有前导零的数字来显示月 (1 – 12)。如果 m 是直接跟在 h 或 hh 之后，那么显示的将是分而不是月。 mm

ACCESS-VBA编程

以有前导零的数字来显示月 (01 – 12)。如果m是直接跟在h或hh之后，那么显示的将是分而不是月。 mmm

以简写来表示月 (Jan –Dec)。 mmmm

以全称来表示月 (January –December)。 oooo

与mmmm一样，它只是该字符串的本地化版本。 Q

将一年中的季以数值表示 (1 – 4)。 Y

将一年中的日以数值表示 (1 – 366)。 Yy

以两位数来表示年 (00 – 99)。 yyyy

以四位数来表示年 (00 – 99)。 H

以没有前导零的数字来显示小时 (0 – 23)。 Hh

以有前导零的数字来显示小时 (00– 23)。 N

以没有前导零的数字来显示分 (0 – 59)。 Nn

以有前导零的数字来显示分 (00 – 59)。 S

以没有前导零的数字来显示秒 (0 – 59)。 Ss

以有前导零的数字来显示秒 (00 – 59)。 t t t t t

以完整时间表示法显示（包括时、分、秒），用系统识别的时间格式定义的时间分隔符进行格式化。如果选择有前导零并且时间是在 10:00 A.M. 或 P.M.之前，那么将显示有前导零的时间。缺省的时间格式为 h:mm:ss。 AM/PM

在中午前以 12 小时配合大写 AM 符号来使用；在中午和 11:59 P.M.间以 12 小时配合大写 PM 来使用。 Am/pm

在中午前以 12 小时配合小写 am 符号来使用；在中午和 11:59 P.M.间以 12 小时配合小写 pm 来使用。 A/P

在中午前以 12 小时配合大写A符号来使用；在中午和 11:59 P.M.间以12 小时配合大写P来使用。 a/p

在中午前以 12 小时配合小写a符号来使用；在中午和 11:59 P.M.间以 12 小时配合小写p来使用。 AMPM

在中午前以 12 小时配合系统设置的 AM字符串文字来使用；在中午和 11:59 P.M. 间以 12 小时配合系统设置的 PM 字符串文字来使用。AMPM 可以是大写或小写，但必须和您的系统设置相配。其缺省格式为 AM/PM。日期函数示例

当天日期：=Date() 当日：=Day(date) 当月：=Month(date()) 当年：=Year(date())

当季：=DatePart(\把日期大写

Function Date2Chinese(iDate) Dim num(10) Dim iYear

ACCESS-VBA编程

Dim iMonth Dim iDay

num(0) = \〇\ num(1) = \一\ num(2) = \二\ num(3) = \三\ num(4) = \四\ num(5) = \五\ num(6) = \六\ num(7) = \七\ num(8) = \八\ num(9) = \九\

iYear = Year(iDate) iMonth = Month(iDate) iDay = Day(iDate)

Date2Chinese = num(iYear \\ 1000) + _

num((iYear \\ 100) Mod 10) + num((iYear _ \\ 10) Mod 10) + num(iYear Mod _ 10) + \年\ If iMonth >= 10 Then

If iMonth = 10 Then

Date2Chinese = Date2Chinese + _ \十\月\ Else

Date2Chinese = Date2Chinese + _ \十\月\ End If Else

Date2Chinese = Date2Chinese + _ num(iMonth Mod 10) + \月\ End If

If iDay >= 10 Then

If iDay = 10 Then

Date2Chinese = Date2Chinese + _ \十\日\

ElseIf iDay = 20 Or iDay = 30 Then Date2Chinese = Date2Chinese + _ num(iDay \\ 10) + \十\日\ ElseIf iDay > 20 Then

Date2Chinese = Date2Chinese + _ num(iDay \\ 10) + \十\ num(iDay Mod 10) + \日\ Else

Date2Chinese = Date2Chinese + _ \十\日\ End If Else

Date2Chinese = Date2Chinese + _ num(iDay Mod 10) + \日\

ACCESS-VBA编程

End If End Function

算出每个月的天数一法：

Dim a, b, c a = Year(Now()) b = Month(Now())

c = Format((a & \二法：

DateDiff(\DateDiff可以算出两个日期之间相差几天！三法：

Day(DateAdd(\

day函数可以知道某个日期是这个月的第几天，我们把这个月的最后一天拿出来DAY一下！应该还有更好的方法！

比如说可以定义一个数组，把每个月的日子放进去，或者说写一个函数算每一个月的天数只要考虑一下闺年的问题就可以了！

如何得到某年每个月的第一天是星期几 Private Sub Command1_Click()

Dim i As Integer, A As Integer, B As Integer, C As String A = InputBox(\请输入年份\某年每个月的第一天是星期几\Form1.Cls

For i = 1 To 12

C = A & \B = Weekday(C) Select Case B Case vbSunday

Print A & \年\月1日是星期日\Case vbMonday

Print A & \年\月1日是星期一\Case vbTuesday

Print A & \年\月1日是星期二\Case vbWednesday

Print A & \年\月1日是星期三\Case vbThursday

Print A & \年\月1日是星期四\Case vbFriday

Print A & \年\月1日是星期五\Case vbSaturday

Print A & \年\月1日是星期六\End Select Next i End Sub

计算天数及月初月末日期

Function 本月天数(日期 As Date) As Byte

本月天数 = DateSerial(Year(日期), Month(日期) + 1, Day(日期)) - 日期 End Function

ACCESS-VBA编程

Function 月末(日期 As Date) As Date

月末 = DateSerial(Year(日期), Month(日期) + 1, 1) - 1 End Function

Function 月初(日期 As Date) As Date 月初 = 日期 - Day(日期) + 1 End Function

本月最后一日是周几 SELECT

Weekday(DateAdd(\本月最后一日是周几, 下月最后一日是周几 SELECT

Weekday(DateAdd(\下月最后一日是周几, 本月最后一个周5到月底的天数 SELECT

(Weekday(DateAdd(\本月最后一个周5到月底的天数;

下月最后一个周5到月底的天数 SELECT

(Weekday(DateAdd(\下月最后一个周5到月底的天数;

本月最后一个周5的日期 SELECT

DateAdd(\(Date()),Month(Date()),1)-1))+1) Mod 7 AS 本月最后一个周5的日期; 下月最后一个周5的日期 SELECT

DateAdd(\(Date()),Month(Date()),1)-1))+1) Mod 7 AS 下月最后一个周5的日期;

数据输入、查询、计算、连接：通过英特网的ACCESS联接在ACCESS中使用ADO： Private Sub ABC_Click()

Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset cn.OPEN \

rs.OPEN \’ rs.ABC App.Path & \rs.Close cn.Close

MsgBox (\End Sub

Private Sub OPEN_Click() Dim strConnect As String

strConnect = \Dim rs As New ADODB.Recordset

rs.OPEN \远程服务器的IP/test/testdata.dat\Do While Not rs.EOF

ACCESS-VBA编程

Debug.Print rs(\rs.MoveNext Loop End Sub

数据库网络使用时,速度很慢!

即使采取始终隐藏运行一个联接后端表的窗体的办法!也必须运行一次一个无条件的查询(窗体状态)后,速度才比较令人满意!!有没有更好的办法!! 在ADSL连接的互连网,而不是局域网!

一,建立一个隐藏运行的连接后端的窗体.

二,在打开启动窗体时自动运行一个用窗体显示的查询,注意,要显示到最后一条记录,不然,速度只能提高一部分,然后自动关闭该窗体(以上过程都要隐藏,所以实际上看不见,另因为要运行一定的时间,最好设置一个正在连接和连接完毕的的提示框),这样一来,读取速度几乎跟在单机上使用没有区别! 将用户输入的身份证号15位数据转化为18位。

Function IDCode15to18(sCode15 As String) As String

'* 功能:将15的身份证号升为18位(根据GB 11643-1999) '* 参数:原来的号码

'* 返回:升位后的18位号码 Dim i As Integer Dim num As Integer Dim code As String num = 0

IDCode15to18 = Left(sCode15, 6) + \ ' 计算校验位

For i = 18 To 2 Step -1

num = num + (2 ^ (i - 1) Mod 11) * (Mid(IDCode15to18, 19 - i, 1)) Next i

num = num Mod 11 Select Case num Case 0

code = \ Case 1

code = \ Case 2

code = \ Case Else

code = Trim(Str(12 - num)) End Select

IDCode15to18 = IDCode15to18 + code End Function

据身份证号自动输入出生日期 Dim Length As Integer

Length = Len(Me.[身份证号])

If Not IsNull(Length) Then

If Length = 15 Then

Me.[性别] = IIf(Val(Mid(Me.身份证号, 15, 1)) / 2 = Int(Val(Mid(Me.身份证号, 15, 1)) / 2), \女\男\

ACCESS-VBA编程

Me.[出生日期] = \身份证号], 7, 2) & \身份证号], 9, 2) & \身份证号], 11, 2)

ElseIf Length = 18 Then

Me.[性别] = IIf(Val(Mid(Me.身份证号, 17, 1)) / 2 = Int(Val(Mid(Me.身份证号, 17, 1)) / 2), \女\男\

Me.[出生日期] = Mid([身份证号], 7, 4) & \身份证号], 11, 2) & \身份证号], 13, 2) Else

MsgBox \身份证号错误！\

End If

两行代码打开另一数据库 Private Sub 命令4_Click() On Error GoTo Err_命令4_Click Dim strDb As String strDb = \

SendKeys \Exit_命令4_Click: Exit Sub

Err_命令4_Click:

MsgBox Err.Description Resume Exit_命令4_Click End Sub

实现打开外部数据库中的报表。

Private Declare Function apiSetForegroundWindow Lib \ Alias \ (ByVal hwnd As Long) _ As Long

Private Declare Function apiShowWindow Lib \ Alias \ (ByVal hwnd As Long, _ ByVal nCmdShow As Long) _ As Long

Private Const SW_MAXIMIZE = 3 Private Const SW_NORMAL = 1

Function fOpenRemoteReport(strMDB As String, strReport As String, _ Optional intView As Variant) _ As Boolean

' strMDB: 外部数据库名称(含路径) ' strReport: 报表名称 ' intView: 报表的打开方式

Dim objAccess As Access.Application

ACCESS-VBA编程

Dim lngRet As Long

On Error GoTo fOpenRemoteReport_Err

If IsMissing(intView) Then intView = acViewPreview

If Len(Dir(strMDB)) > 0 Then

Set objAccess = New Access.Application With objAccess

lngRet = apiSetForegroundWindow(.hWndAccessApp) lngRet = apiShowWindow(.hWndAccessApp, SW_NORMAL) ' 第一次调用ShowWindow似乎不做任何事情

lngRet = apiShowWindow(.hWndAccessApp, SW_NORMAL) .OpenCurrentDatabase strMDB

.DoCmd.OpenReport strReport, intView Do While Len(.CurrentDb.Name) > 0 DoEvents Loop End With End If

fOpenRemoteReport_Exit: On Error Resume Next objAccess.Quit

Set objAccess = Nothing Exit Function

fOpenRemoteReport_Err:

fOpenRemoteReport = False Select Case Err.Number Case 7866:

' mdb 已经被用独占方式打开

MsgBox \该数据库：\

vbCrLf & \已经被用独占方式打开！\ & vbCrLf & \请重新用共享方式打开，再试一次！\ vbExclamation + vbOKOnly, \不能打开数据库\ Case 2103:

' 报表不存在

MsgBox \在这个\数据库中不存在该报表：\ vbCrLf & vbCrLf , _

vbExclamation + vbOKOnly, \报表不存在\ Case 7952:

' 用户关闭了这个 mdb fOpenRemoteReport = True Case Else:

MsgBox \错误#: \ vbCritical + vbOKOnly, \运行时错误\ End Select

Resume fOpenRemoteReport_Exit End Function

ACCESS-VBA编程

为列表框定数据源 Dim str3 As String

str3 = \jhd_mx_jiage.wp_leibie AS 类别, jhd_mx_jiage.wp_migceg AS 名称, jhd_mx_jiage.wp_xighao AS 型号, jhd_mx_jiage.jhmx_danwei AS 单位, jhd_mx_jiage.jhmx_danjia AS 单价 FROM jhd_mx_jiage \ Me.Listjhwp.RowSource = str3 Me.Listjhwp.Requery

为组合框、子窗体设置数据源

下面的示例将组合框的 RowSourceType 属性设为“Table/Query”，然后将 RowSource 属性设为“雇员列表”查询。

Forms!Employees!cmboNames.RowSourceType = \Forms!Employees!cmboNames.RowSource = \ 一：

Dim str1 As String

str1 = \\ Me.Child6zy.Form.RecordSource = str1 Me.Child6zy.Requery 二：

子窗体.FORM.recordsourse=\ziyuag.zy_daihao, ziyuag.zy_mima,ziyuag.zy_ziwu,ziyuag.zy_xigmig FROM ziyuag \ 三：

Private Sub Command38_Click() Dim sjy As String Dim pd As Integer pd = True

sjy = \病历明细表.* FROM 病历明细表\If Not IsNull(Text0) Then If pd Then

sjy = sjy & \姓名 like '\ pd = False Else

sjy = sjy & \姓名 like '\ End If End If

If Not IsNull(Text1) And Not IsNull(Text2) Then

sjy = sjy & \时间 between #\ pd = False Else

str2 = str2 & \时间 between #\End If

If Not IsNull(Text3) Then If pd Then

sjy = sjy & \姓名 like '\ pd = False Else

sjy = sjy & \姓名 like '\ End If

ACCESS-VBA编程

End If

Me.子窗体.RowSource = sjy Me.Requery End Sub

为主窗体、报表设数据源

使用 RecordSource 属性可以指定窗体或报表的数据源。String 型，可读写。一：

Dim sjy As String

sjy = \名单.* FROM 名单\姓名 like '*\Me.RecordSource = sjy Requery 二：

me.RecordSource = \名单\

用其他ACCESS的表作为本ACCESS 窗体的数据源来源：ACCESS中国 Trynew

在Sql语句中的表名前加上数据库名就行了，下面语句动态引用当前目录的另一MDB文件的表做数据源： Private Sub Form_Load()

Me.RecordSource = \表1.* FROM [\表1;\End Sub

插入／删除一条记录

新建：DoCmd.RunCommand acCmdRecordsGoToNew

删除：DoCmd.RunCommand acCmdDeleteRecord

用代码实现对数据修改或增加的取消

在窗体中修改数据时，关闭窗体，数据已经修改，这样很容易产生错误数据. 可采用如下方法解决: 在窗体更新前判断:

Private Sub FORM_BeforeUpdate(Cancel As Integer)

If MsgBox(\保存吗?\ Cancel = True End If End Sub

' 去除系统的报错信息:

Private Sub FORM_Error(DataErr As Integer, Response As Integer) Response = acDataErrContinue End Sub

检查数据是否被修改，无则退出，有则询问是否保存

'在窗体的字段的“属性”“事件”“更新后”的右边输入“=NoAllowSave()”， '在窗体的“打开”事件中代码“allowSave = False” '定义模块

Option Compare Database Option Explicit

Public allowSave As Boolean Public Function NoAllowSave() allowSave = True

ACCESS-VBA编程

End Function

“退出”按钮的单击事件代码 If allowSave = True Then

If MsgBox(\当前数据已经被修改，是否保存？\请选择...\ Else

Me.Undo End If End If

DoCmd.Close 定义记录集

Dim rst As New ADODB.Recordset 打开记录集

rst.Open \语句, 关键字 FROM 结果语句表\adLockOptimistic

两子窗体之间字段赋值：

Forms!aaa!bbb.Form!bb = Forms!aaa!ccc.Form!cc

确定所显示的当前记录的记录编号。

下面的示例显示如何使用 Currentrecord 属性来确定所显示的当前记录的记录编号。在通用过程 Currentformrecord 中将当前记录的编号值赋给变量 Lngrecordnum。

Sub CurrentFormRecord(frm As Form) Dim lngrecordnum As Long

lngrecordnum = frm.CurrentRecord 'CurrentRecord是当前记录号 End Sub

读取最后一条记录

dlast(\字段名\表名\

在字段默认值中用此函数能使该字段的新纪录显示上一条记录该字段的值怎样使窗体一打开就定位到指定记录上

定义了一个变量lngbh，要窗体打开时显示ID=Lngbh的这条记录。

DoCmd.OpenForm \使用API函数sendmessage，获得光标所在行和列。

Sub getcaretpos(byval TextHwnd&,LineNo&,ColNo&)

注释：TextHwnd为TextBox的hWnd属性值， LineNo为所在行数，ColNo为列数 dim I&,j&,k& 注释：获取起始位置到光标所在位置字节数 I=SendMessage(TextHwnd,&HB0&,0,0) j=I/2^16 注释：确定所在行 LineNo=SendMessage(TextHwnd,&HC9&,j,0)+1 注释：确定所在列

k=SendMessage(TextHwnd,&HBB&,-1,0) ColNo=j-k+1 End sub

如何在打开窗体时自动到相应记录

用法:DoCmd.RunCommand acCmdRecordsGoToNew acCmdRecordsGoToFirst 移到第一条记录 acCmdRecordsGoToLast 移到最后一条记录 acCmdRecordsGoToNew 新增一条记录 acCmdRecordsGoToNext 移到下一条记录

acCmdRecordsGoToPrevious 移到上一条记录

ACCESS-VBA编程

Dim qdf As DAO.QueryDef 'qdf被定义为一个查询定义对象 Dim strWhere, strSQL As String

strWhere = Me.存书查询子窗体.Form.Filter If strWhere = \ '没有条件

strSQL = \存书查询]\ Else

'有条件

strSQL = \存书查询] WHERE \ End If

Set qdf = CurrentDb.QueryDefs(\查询结果\ qdf.SQL = strSQL qdf.Close

Set qdf = Nothing

DoCmd.OutputTo acOutputQuery, \查询结果\

Exit_cmd导出_Click: Exit Sub

Err_cmd导出_Click:

MsgBox Err.Description Resume Exit_cmd导出_Click End Sub

Private Sub cmd清除_Click() On Error GoTo Err_cmd清除_Click '刘小军(Alex) 2003-5-22

'这里将使用FOR EACH CONTROL的方法来清除控件的值 '这在控件比较多的时候非常有用。

'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

Dim ctl As Control

For Each ctl In Me.Controls

'根据ctl的控件类型来选择 Select Case ctl.ControlType

Case acTextBox '是文本框，要清空(注意，子窗体下面还有两个锁定的文本框不能赋值) If ctl.Locked = False Then ctl.Value = Null

Case acComboBox '是组合框，也要清空 ctl.Value = Null '其它类型的控件不处理

End Select

ACCESS-VBA编程

'取消子窗体的筛选

Me.存书查询子窗体.Form.Filter = \

Me.存书查询子窗体.Form.FilterOn = False

'在子窗体取消筛选后要运行一下自编子程序CheckSubformCount() Call CheckSubformCount

Exit_cmd清除_Click: Exit Sub

Err_cmd清除_Click:

MsgBox Err.Description Resume Exit_cmd清除_Click End Sub

Private Sub cmd预览报表_Click() On Error GoTo Err_cmd预览报表_Click

Dim stDocName, strWhere As String

stDocName = \藏书情况报表\

strWhere = Me.存书查询子窗体.Form.Filter

'在打开报表的同时把子窗体的筛选条件字符串也传递给报表， '这样地话报表也会显示和子窗体相同的记录。

DoCmd.OpenReport stDocName, acPreview, , strWhere

Exit_cmd预览报表_Click: Exit Sub

Err_cmd预览报表_Click: MsgBox Err.Description

Resume Exit_cmd预览报表_Click End Sub

Private Sub CheckSubformCount() '刘小军(Alex) 2003-5-22

'这是一个自编子程序，专门用来检查子窗体上的记录数， '以便修改主窗体上的“计数”和“合计”的控件来源， '以防止出现“#错误”。

'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

If Me.存书查询子窗体.Form.Recordset.RecordCount > 0 Then '子窗体的记录数>0

Me.计数.ControlSource = \存书查询子窗体].[Form].[txt计数]\

Me.合计.ControlSource = \存书查询子窗体].[Form].[txt单价合计]\

ACCESS-VBA编程

Else

'子窗体的记录数=0

Me.计数.ControlSource = \ Me.合计.ControlSource = \ End If End Sub

用VBA代码+DAO生成带条件的交叉表查询 Option Compare Database

'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ '刘小军（ALEX），2003-5-26 '

'由浅入深的介绍几种最常用的利用主/子窗体来实现查询的方法， '使初学者和有一定VBA基础的人可以更好的使用窗体查询这种手段。 '

'本例程是讲解用VBA代码+DAO生成带条件的交叉表查询。 '

'欢迎访问 ACCESS编程应用网 www.accxp.com

'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

Private Sub cmd查询_Click() On Error GoTo Err_cmd查询_Click

Dim strWhere As String '定义条件字符串

Dim qdf As DAO.QueryDef 'qdf被定义为一个查询定义对象 Dim strSQL As String

strWhere = \设定初始值－空字符串

'判断【类别】条件是否有输入的值 If Not IsNull(Me.类别) Then '有输入

strWhere = strWhere & \类别] like '\类别 & \ End If

'判断【出版社】条件是否有输入的值 If Not IsNull(Me.出版社) Then '有输入

strWhere = strWhere & \出版社] like '\出版社 & \ End If

'判断【单价】条件是否有输入的值，由于有【单价开始】【单价截止】两个文本框 '所以要分开来考虑

If Not IsNull(Me.单价开始) Then '【单价开始】有输入

strWhere = strWhere & \单价] >= \单价开始 & \ End If

If Not IsNull(Me.单价截止) Then '【单价截止】有输入

ACCESS-VBA编程

strWhere = strWhere & \单价] <= \单价截止 & \ End If

'判断【进书日期】条件是否有输入的值，由于有【进书日期开始】【进书日期截止】两个文本框 '所以要分开来考虑

If Not IsNull(Me.进书日期开始) Then '【进书日期开始】有输入

strWhere = strWhere & \进书日期] >= #\进书日期开始, \\

End If

If Not IsNull(Me.进书日期截止) Then '【进书日期截止】有输入

strWhere = strWhere & \进书日期] <= #\进书日期截止, \\

End If

'如果输入了条件，那么strWhere的最后肯定有\，这是我们不需要的， '要用LEFT函数截掉这5个字符。 If Len(strWhere) > 0 Then '有输入条件

strWhere = Left(strWhere, Len(strWhere) - 5) End If

'先在立即窗口显示一下strWhere的值，代码调试完成后可以取消下一句 'Debug.Print strWhere

'根据是否有条件来设定交叉表查询的SQL语句 If Len(strWhere) > 0 Then

strSQL = \存书查询.单价) AS 单价之Sum SELECT 存书查询.类别 FROM 存书查询 \ strSQL = strSQL & \

strSQL = strSQL & \存书查询.类别 PIVOT Format([进书日期],'yyyy/mm')\ Else

strSQL = \存书查询.单价) AS 单价之Sum\ \存书查询.类别\ \存书查询\

\存书查询.类别\

\进书日期],'yyyy/mm')\ End If

'修改交叉表查询的SQL语句

Set qdf = CurrentDb.QueryDefs(\存书查询_交叉表\ qdf.SQL = strSQL qdf.Close

Set qdf = Nothing

'显示交叉表的内容，不能直接刷新 Me.存书查询子窗体.SourceObject = \

Me.存书查询子窗体.SourceObject = \查询.存书查询_交叉表\

ACCESS-VBA编程

'刷新计数和合计显示

Me.计数 = DCount(\存书查询_交叉表\

Me.合计 = DSum(\单价]\存书查询\

Exit_cmd查询_Click: Exit Sub

Err_cmd查询_Click:

MsgBox Err.Description Resume Exit_cmd查询_Click End Sub

Private Sub cmd导出_Click() On Error GoTo Err_cmd导出_Click '刘小军(Alex) 2003-5-27

'由于前面我们已经通过DAO修改了“存书查询_交叉表”的SQL语句， '所以这里我们直接导出就可以了。

'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

DoCmd.OutputTo acOutputQuery, \存书查询_交叉表\

Exit_cmd导出_Click: Exit Sub

Err_cmd导出_Click:

MsgBox Err.Description Resume Exit_cmd导出_Click End Sub

Private Sub cmd清除_Click() On Error GoTo Err_cmd清除_Click '刘小军(Alex) 2003-5-27

'这里将使用FOR EACH CONTROL的方法来清除控件的值 '这在控件比较多的时候非常有用。

'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

Dim ctl As Control

Dim qdf As DAO.QueryDef 'qdf被定义为一个查询定义对象 Dim strSQL As String

For Each ctl In Me.Controls

'根据ctl的控件类型来选择 Select Case ctl.ControlType

Case acTextBox '是文本框，要清空(注意，子窗体下面还有两个锁定的文本框不能赋值) If ctl.Locked = False Then ctl.Value = Null

ACCESS-VBA编程.doc 将本文的Word文档下载到电脑下载失败或者文档不完整，请联系客服人员解决！

下载这篇word文档