|
|
在ACCESS中使用ADO：
Private Sub ABC_Click()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
cn.OPEN "DSN=alwin;UID=;PWD=;"
rs.OPEN "Select * from tbTABLE", cn, adOpenDynamic, adLockReadOnly’
rs.ABC App.Path & "\testdata.dat", adPersistADTG
rs.Close
cn.Close
MsgBox ("OPERATION OK")
End Sub
Private Sub OPEN_Click()
Dim strConnect As String
strConnect = "Provider=MSPersist"
Dim rs As New ADODB.Recordset
rs.OPEN "http://远程服务器的IP/test/testdata.dat", strConnect
Do While Not rs.EOF
Debug.Print rs("USERID").value
rs.MoveNext
Loop
End Sub
将用户输入的身份证号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) + "19" + Right(sCode15, 9)
' 计算校验位
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 = "1"
Case 1
code = "0"
Case 2
code = "X"
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), "女", "男")
Me.[出生日期] = "19" & Mid([身份证号], 7, 2) & "-" & Mid([身份证号], 9, 2) & "-" & Mid([身份证号], 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) & "-" & Mid([身份证号], 11, 2) & "-" & Mid([身份证号], 13, 2)
Else
MsgBox "身份证号错误！"
End If
End If
两行代码打开另一数据库
Private Sub 命令4_Click()
On Error GoTo Err_命令4_Click
Dim strDb As String
strDb = "C:\db1.mdb"
SendKeys "{F11}%FO" & strDb & "{enter}"
Exit_命令4_Click:
Exit Sub
Err_命令4_Click:
MsgBox Err.Description
Resume Exit_命令4_Click
End Sub
实现打开外部数据库中的报表。
Private Declare Function apiSetForegroundWindow Lib "user32" _
Alias "SetForegroundWindow" _
(ByVal hwnd As Long) _
As Long
Private Declare Function apiShowWindow Lib "user32" _
Alias "ShowWindow" _
(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
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 "该数据库：" & strMDB & _
vbCrLf & "已经被用独占方式打开！" & vbCrLf _
& vbCrLf & "请重新用共享方式打开，再试一次！", _
vbExclamation + vbOKOnly, "不能打开数据库"
Case 2103:
' 报表不存在
MsgBox "在这个" & strMDB & "数据库中不存在该报表：" & strReport & _
vbCrLf & vbCrLf , _
vbExclamation + vbOKOnly, "报表不存在"
Case 7952:
' 用户关闭了这个 mdb
fOpenRemoteReport = True
Case Else:
MsgBox "错误#: " & Err.Number & vbCrLf & Err.Description, _
vbCritical + vbOKOnly, "运行时错误"
End Select
Resume fOpenRemoteReport_Exit
End Function
为列表框定数据源
Dim str3 As String
str3 = "Select 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 " & " where jhd_mx_jiage.wp_leibie='" & Listjhlb & "'"
Me.Listjhwp.RowSource = str3
Me.Listjhwp.Requery
为组合框、子窗体设置数据源
下面的示例将组合框的 RowSourceType 属性设为“Table/Query”，然后将 RowSource 属性设为“雇员列表”查询。
Forms!Employees!cmboNames.RowSourceType = "Table/Query"
Forms!Employees!cmboNames.RowSource = "EmployeeList"
一：
Dim str1 As String
str1 = "Select ziyuag.zy_daihao, ziyuag.zy_mima,ziyuag.zy_ziwu,ziyuag.zy_xigmig FROM ziyuag " & " where zy_daihao='" & Text8dldh & "'and zy_mima='" & Text10dlmm & "'"
Me.Child6zy.Form.RecordSource = str1
Me.Child6zy.Requery
二：
子窗体.FORM.recordsourse="Select ziyuag.zy_daihao, ziyuag.zy_mima,ziyuag.zy_ziwu,ziyuag.zy_xigmig FROM ziyuag " & " where zy_daihao='" & Text8dldh & "'and zy_mima='" & Text10dlmm & "'"
三：
Private Sub Command38_Click()
Dim sjy As String
Dim pd As Integer
pd = True
sjy = "Select 病历明细表.* FROM 病历明细表"
If Not IsNull(Text0) Then
If pd Then
sjy = sjy & " where 姓名 like '" & Text0 & "'"
pd = False
Else
sjy = sjy & " and 姓名 like '" & Text0 & "'"
End If
End If
If Not IsNull(Text1) And Not IsNull(Text2) Then
sjy = sjy & " where 时间 between #" & Text1 & "# and #" & Text2 & "#"
pd = False
Else
str2 = str2 & " and 时间 between #" & Text1 & "# and #" & Text2 & "#"
End If
If Not IsNull(Text3) Then
If pd Then
sjy = sjy & " where 姓名 like '" & Text3 & "'"
pd = False
Else
sjy = sjy & " and 姓名 like '" & Text3 & "'"
End If
End If
Me.子窗体.RowSource = sjy
Me.Requery
End Sub
为主窗体、报表设数据源
使用 RecordSource 属性可以指定窗体或报表的数据源。String 型，可读写。
一：
Dim sjy As String
sjy = "Select 名单.* FROM 名单" & " where 姓名 like '*" & List101 & "*'"
Me.RecordSource = sjy
Requery
二：
me.RecordSource = "名单"
用其他ACCESS的表作为本ACCESS 窗体的数据源
来源：ACCESS中国 Trynew
在Sql语句中的表名前加上数据库名就行了，下面语句动态引用当前目录的另一MDB文件的表做数据源：
Private Sub Form_Load()
Me.RecordSource = "Select 表1.* FROM [" & CurrentProject.Path & "\db1.mdb" & "].表1;"
End Sub
用VBA编程把Excel表中数据追加到Access表中
Private Sub Command0_Click()
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "temp", "c:\temp.xls", yes
End Sub
VB语句删除记录：
For I = 1 To 20
SQL = "Delete 订单明细ID FROM 订单明细 Where 订单明细ID=" & I
DoCmd.RunSQL SQL
Next
或：
CurrentProject.Connection.Execute "Delete * FROM要删除记录的表"
插入／删除一条记录
新建：DoCmd.RunCommand acCmdRecordsGoToNew
删除：DoCmd.RunCommand acCmdDeleteRecord
清空表记录的方法
1、CurrentDb().Execute "delete * from 表名"
2、docmd.runsql "SQL语句"
3，RunSQL "Delete * From 表名"
用代码实现对数据修改或增加的取消
在窗体中修改数据时，关闭窗体，数据已经修改，这样很容易产生错误数据.
可采用如下方法解决:
在窗体更新前判断:
Private Sub FORM_BeforeUpdate(Cancel As Integer)
If MsgBox("保存吗?", vbYesNo, Me.Caption) <> vbYes Then
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
End Function
“退出”按钮的单击事件代码
If allowSave = True Then
If MsgBox("当前数据已经被修改，是否保存？", vbYesNo + vbQuestion, "请选择...") = vbYes Then
Else
Me.Undo
End If
End If
DoCmd.Close
定义记录集
Dim rst As New ADODB.Recordset
打开记录集
rst.Open "Select 语句, 关键字 FROM 结果语句表", CurrentProject.Connection, adOpenKeyset, 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 "formname", acNormal, , "ID =" & LNGBH, acFormEdit, acWindowNormal
使用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中国 ysf
me.Recordset.AbsolutePosition = 0 '第一条记录
me.Recordset.AbsolutePosition = me.Recordset.RecordCount -1 '最后一条记录
me.Recordset.AbsolutePosition=-1 '第一条记录前 me.Recordset.bof=true
me.Recordset.AbsolutePosition=me.Recordset.RecordCount '最后一条记录后 me.Recordset.eof=true
me.Recordset.AbsolutePosition=n '第n+1条记录
判断为是否新增记录
me.newrecord=true
me.newrecord=false
自动编号
一：
=IIf(Left(Nz(DMax("[jhd_id]","jinhuodan",""),0),6)<>Format(Date(),"yyyymm"),Format(Date(),"yyyymm") & "001",Format(Date(),"yyyymm") & Format(Val(Right(Nz(DMax("[jhd_id]","jinhuodan",""),0),3))+1,"000"))
二：
=nz(DLookUp("编号","登记表","[id]=DMax('id','登记表')"))+1
自动编号
方法一按时间自动编号：
dim a,b
a=dmax("[自动编号]","编号表")+1
b=format(date(),"yyyymm") & 00
if a>b then
me.自动编号=a
else:
me.自动编号=b+1
end if
方法二，按时间自动编号：
Dim a As String
a = Nz(DMax("销售单号", "销售帐单", ""), 0)
If Left(a, 6) <> Format(Date, "yyyymm") Then
销售单号 = Format(Date, "yyyymm") & "01"
Else
销售单号 = Format(Date, "yyyymm") & Format(Val(Right(a, 2)) + 1, "00")
End If
方法三，按月分类自动编号：
Dim id, date2 As String
date2 = "GF" & [部门代码] & Format([入库日期], "YYYYMM")
id = DMax("[rk编号]", "[入库单]", "[rk编号] Like '" & date2 & "???'")
If IsNull(id) Then
Me.RK编号 = date2 & "001"
Else
Me.RK编号 = date2 & Format(CStr(CInt(Right(id, 3)) + 1), "000")
End If
按任意输入的日期值的年月自动编号
Dim a, b, c
c = Format(Me.凭证日期, "yyyymm")
b = Nz(c, 0) * 1000
a = Nz(DMax("[凭证号码]", "凭证", "format(凭证.凭证日期,'yyyymm')=format([forms]![凭证录入].[凭证日期],'yyyymm')"), 0) + 1
If a > b Then
Me.凭证号码 = a
Else:
Me.凭证号码 = b + 1
End If
|
评分
-
1
查看全部评分
-
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2013-5-10 15:10
