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
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
16
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
17
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
18
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
19
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 移到上一条记录
20