Access编程学习手札.doc

Access编程学习手札（一）注册和登陆窗体1安全设置2判断文件和文件夹是否存在函数4在表中新增一个字段的代码5执行压缩和修复数据库的代码6Access输出资料到Word用于打印6公历农历计算函数13逐条删除子窗体中的记录20为主窗体、报表设置数据源的方法21超好用的智能文本框通用函数21ACCESS中如何禁用Shift键和启用Shift键22论述Access和Execl互相结合的作用23在子窗体数据表中应用DCOUNT函数24如何解决禁止用SHIFT键打开MDB/MDE文件25附件链接25（一）注册和登陆窗体1.1 注册窗体1.1.1 用户名提示制作label提示 form_load() 设置.caption= “新用户注册”判断函数：IsNull(Dlookup (“密码”,”用户管理表”,”用户名=” & Me.txt用户名 & “”)1.1.2 注册DoCmd.RunSQL INSERT INTO 用户管理表 (用户名,管理级别,密码) VALUES ( & & UserName & & , & & pass & , & & password & & )1.2 登录窗体1.2.1 使程序窗口最小化 DoCmd.RunCommand acCmdAppMinimize1.2.2 保存最后一次登录信息 建立登录信息保存表 （用户名；密码；是否保存；用户id【数值型】） 调用该表信息 Set dbs = CurrentDb Set rec = dbs.openRecordSet(登录信息保存表) rec.MoveFirst If rec!是否保存 = True Then Me.txt用户名=rec!用户名 Me.txt密码=rec!密码 Me.是否保存.value = rec!是否保存 Else Me.txt用户名=” Me.txt密码=” End If rec.close dbs.close Set dbs = Nothing Set rec = Nothing1.2.3 判断登录密码 Me.txt密码=Dlookup(“密码”,”用户管理表”,”用户名=” & Me.txt用户名 & “”)1.2.4 保存当前用户信息 Docmd.RunSQL “UPDATE 登录信息保存表 SET 是否保存=true , 用户名= ” & Me.txt用户名 & “,密码=” & Me.txt密码 & “ where 用户id=1”1.2.5 更新登录次数 Docmd.RunSQL “UPDATE 用户管理表 SET 登录次数 = DLookup(登录次数, 用户管理表, 用户名= & Me.Text用户名 & ) + 1 & “, 上次登录时间=#” & format(Date,”yyyy-mm-dd”) & “# where 用户名= “ & Me.txt用户名 & “”安全设置Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer Dim dbs As Object, prp As VariantConst conPropNotFoundError = 3270 Set dbs = CurrentDb On Error GoTo Change_Err dbs.Properties(strPropName) = varPropValue ChangeProperty = TrueChange_Bye: Exit FunctionChange_Err: If Err = conPropNotFoundError Then Property not found. Set prp = dbs.CreateProperty(strPropName,varPropType, varPropValue) dbs.Properties.Append prpResume Next Else Unknown error. ChangeProperty = False Resume Change_Bye End IfEnd Function以下代码放在启动窗体中Private Sub Form_Open(Cancel As Integer)Dim Strmde As StringOn Error Resume NextStrmde = CurrentDb.Properties(mde)If Err.Number = 0 And Strmde = t Then ChangeProperty AllowBypassKey, 1, False False为禁止Shift键，True为恢复Else ChangeProperty AllowBypassKey, 1, True False为禁止Shift键，True为恢复End IfEnd Sub如要用命令调用可用如下方法Private Sub 允许_Click() On Error Resume Next ChangeProperty AllowBypassKey, 1, True False为禁止Shift键，True为恢复End SubPrivate Sub 禁止_Click() On Error Resume Next ChangeProperty AllowBypassKey, 1, FalseEnd Sub判断文件和文件夹是否存在函数Function FileExists(ByVal strFile As String, Optional bFindFolders As Boolean) As Boolean Purpose: Return True if the file exists, even if it is hidden. Arguments: strFile: File name to look for. Current directory searched if no path included. bFindFolders. If strFile is a folder, FileExists() returns False unless this argument is True. Note: Does not look inside subdirectories for the file. Author: Allen Browne. June, 2006. Dim lngAttributes As Long Include read-only files, hidden files, system files. lngAttributes = (vbReadOnly Or vbHidden Or vbSystem) If bFindFolders Then lngAttributes = (lngAttributes Or vbDirectory) Include folders as well. Else Strip any trailing slash, so Dir does not look inside the folder. Do While Right$(strFile, 1) = strFile = Left$(strFile, Len(strFile) - 1) Loop End If If Dir() returns something, the file exists. On Error Resume Next FileExists = (Len(Dir(strFile, lngAttributes) 0)End FunctionFunction FolderExists(strPath As String) As Boolean On Error Resume Next FolderExists = (GetAttr(strPath) And vbDirectory) = vbDirectory)End FunctionFunction TrailingSlash(varIn As Variant) As String If Len(varIn) 0 Then If Right(varIn, 1) = Then TrailingSlash = varIn Else TrailingSlash = varIn & End If End IfEnd Function在表中新增一个字段的代码在表4中新增区域字段Private Sub Command0_Click()On Error GoTo Err_Command0_ClickDim zdStr As StringDim StrSel As StringDim rs As ADODB.RecordsetStrSel = Select * FROM 表4Set rs = New ADODB.Recordsetrs.Open StrSel, CurrentProject.Connection, adOpenStatic, adLockBatchOptimisticFor i = 0 To rs.Fields.Count - 1 If 区域 rs.Fields(i).Name Then rs.Close zdStr = Alter TABLE 表4 ADD COLUMN 区域 text(20) DoCmd.RunSQL zdStr rs.Open StrSel, CurrentProject.Connection, adOpenStatic, adLockBatchOptimistic End IfNextExit_Command0_Click: Exit SubErr_Command0_Click: MsgBox Err.Description Resume Exit_Command0_ClickEnd Sub执行压缩和修复数据库的代码CommandBars(menu bar).Controls(工具(&T).Controls(数据库实用工具(&D).Controls(压缩和修复数据库(&C).).accDoDefaultActionAccess输出资料到Word用于打印方法一：Functionexport_word_use_range() 请先引用word DimobjWordAsNewWord.Application DimragRangeAsRange DimIls1AsInlineShape objWord.Documents.add objWord.WindowState=wdWindowStateMaximize objWord.Visible=True objWord.ActiveDocument.PageSetup.LeftMargin=30 objWord.ActiveDocument.PageSetup.RightMargin=30 SetragRange=objWord.ActiveDocument.Paragraphs.add.Range ragRange.InsertBefore标题 ragRange.Font.Bold=True ragRange.Font.Size=22 ragRange.ParagraphFormat.Alignment=wdAlignParagraphCenter 引用ado DimRsAsNewADODB.Recordset Rs.Openselect*fromtemporderby课程名称,类型名称,临时编号,CurrentProject.Connection,1,1 IfRs.EOFAndRs.BOFThen MsgBox没有任何记录 ExitFunction EndIf SetragRange=Nothing DimstrTypeAsString DimlngNOAsLong DimlngTopicNoAsLong LoadTopicNo DoUntilRs.EOF IfstrTypeRs(类型名称)Then lngTopicNo=lngTopicNo+1 SetragRange=objWord.ActiveDocument.Paragraphs.add.Range ragRange.InsertBeforestrTopicNo(lngTopicNo)&、&Rs(类型名称)&： ragRange.InsertBeforevbCrLf ragRange.Bold=True ragRange.Font.Size=15 strType=Rs(类型名称) lngNO=0 EndIf lngNO=lngNO+1 SetragRange=objWord.ActiveDocument.Paragraphs.add.Range ragRange.InsertBeforeStr(lngNO)&. &Nz(Rs(试题内容),) ragRange.Bold=False ragRange.Font.Size=10 IfLen(Nz(Rs(图形),)0Then SetIls1=objWord.ActiveDocument.InlineShapes.AddPicture(filename:=_ Rs(图形),_ LinkTofile:=False,SaveWithDocument:=True) EndIf SetragRange=objWord.ActiveDocument.Paragraphs.add.Range ragRange.InsertBeforeChr(9)&第&Str(lngNO)&.题答案： &Nz(Rs(试题答案),) ragRange.Bold=False ragRange.Font.Size=10 ragRange.Font.Color=wdColorLightBlue Rs.MoveNext Loop Rs.Close SetragRange=objWord.ActiveDocument.Paragraphs.add.Range ragRange.InsertAfter试卷生成日期：&FormatDateTime(Now,vbLongDate)&FormatDateTime(Now,vbLongTime) ragRange.Font.Bold=False ragRange.Font.Size=10 ragRange.ParagraphFormat.Alignment=wdAlignParagraphRightEndFunction方法二：Functionexport_word_use_selection() 请先引用word DimobjWordAsNewWord.Application DimSlt1AsSelection DimIls1AsInlineShape objWord.Documents.add objWord.WindowState=wdWindowStateMaximize objWord.Visible=True objWord.ActiveDocument.PageSetup.LeftMargin=30 objWord.ActiveDocument.PageSetup.RightMargin=30 SetSlt1=objWord.ActiveWindow.Selection Slt1.Font.Size=22 Slt1.Font.Bold=True Slt1.ParagraphFormat.Alignment=wdAlignParagraphCenter Slt1.InsertBefore标题&vbCrLf Slt1.MoveDownUnit:=wdParagraph,Count:=1,Extend:=wdMove 引用ado DimRsAsNewADODB.Recordset Rs.Openselect*fromtemporderby课程名称,类型名称,临时编号,CurrentProject.Connection,1,1 IfRs.EOFAndRs.BOFThen MsgBox没有任何记录 ExitFunction EndIf DimstrTypeAsString DimlngNOAsLong DimlngTopicNoAsLong LoadTopicNo DoUntilRs.EOF IfstrTypeRs(类型名称)Then lngTopicNo=lngTopicNo+1 Slt1.Font.Bold=True Slt1.Font.Size=15 Slt1.ParagraphFormat.Alignment=wdAlignParagraphThaiJustify Slt1.InsertBeforestrTopicNo(lngTopicNo)&、&Rs(类型名称)&：&vbCrLf Slt1.MoveDownUnit:=wdParagraph,Count:=1,Extend:=wdMove strType=Rs(类型名称) lngNO=0 EndIf lngNO=lngNO+1 Slt1.Font.Bold=False Slt1.Font.Size=10 Slt1.InsertBeforeChr(9)&Str(lngNO)&. &Nz(Rs(试题内容),)&vbCrLf Slt1.MoveDownUnit:=wdParagraph,Count:=1,Extend:=wdMove IfLen(Nz(Rs(图形),)0Then Slt1.InlineShapes.AddPicturefilename:=Rs(图形),LinkTofile:=False,SaveWithDocument:=True Slt1.InsertBeforevbCrLf Slt1.MoveDownUnit:=wdParagraph,Count:=1,Extend:=wdMove EndIf Slt1.Font.Bold=False Slt1.Font.Size=10 Slt1.Font.Color=wdColorLightBlue Slt1.InsertBeforeChr(9)&Chr(9)&第&Str(lngNO)&.题答案： &Nz(Rs(试题答案),)&vbCrLf Slt1.MoveDownUnit:=wdParagraph,Count:=1,Extend:=wdMove Slt1.Font.Color=wdColorAutomatic Rs.MoveNext Loop Rs.Close Slt1.InsertBeforevbCrLf Slt1.InsertBeforevbCrLf Slt1.InsertAfter试卷生成日期：&FormatDateTime(Now,vbLongDate)&FormatDateTime(Now,vbLongTime) Slt1.Font.Bold=False Slt1.Font.Size=10 Slt1.ParagraphFormat.Alignment=wdAlignParagraphRightEndFunction方法三：Sub命令0_Click()输入表格标题Title=InputBox(vbCrLf&vbCrLf&请输入表格标题：,表格标题,XX公司产品报价单)IfTitle=ThenTitle=XX公司产品报价单步骤1：建立数据连接cnn由于数据库已经打开，所以直接应用CurrentProject.Connection就可以建立连接Setcnn=NewADODB.ConnectionSetcnn=CurrentProject.Connection步骤2：用SQL语句创建记录集rsSetrs=NewADODB.Recordset设定游标类型与锁定类型rs.CursorType=adOpenKeysetrs.LockType=adLockOptimistic制定特定的查询条件，可以是任何有效的SQL查询，甚至包括多表、多条件等复杂的查询，查询条件也常常从窗体取得SQL=select产品名称,单位数量,单价,库存量from产品where单价10.00创建记录集rsrs.OpenSQL,cnn统计字段数及记录数total_fields=rs.Fields.Counttotal_records=rs.RecordCount步骤3：建立Word文档对象Setmywdapp=CreateObject(word.application)调整Word窗口大小mywdapp.WindowState=wdWindowStateNormal生成新的Word文档实例mywdapp.Documents.Add设置视图为页面视图mywdapp.ActiveWindow.View.Type=wdPrintView转到Word视图，显示文档生成过程mywdapp.Visible=Truemywdapp.Activate设置文档(表格)字体mywdapp.ActiveDocument.Range.Font.Size=9步骤4：将记录集rs中的字段名称和字段内容输出到Word，各字段之间用制表符分隔输出字段名称ForI=0Tototal_fields-2mywdapp.Selection.TypeTextText:=rs.Fields(I).Name&vbTabNextI最后一个字段名称后加回车符mywdapp.Selection.TypeTextText:=rs.Fields(total_fields-1).Name&vbCrLf逐条输出字段内容DoWhileNotrs.EOFForI=0Tototal_fields-2tmpstr=rs.Fields(I).valueIfrs.Fields(I).Name=单价Thentmpstr=Format(tmpstr,#.00)EndIfmywdapp.Selection.TypeTextText:=tmpstr&vbTabNextI一条记录的最后一个字段后加回车符mywdapp.Selection.TypeTextText:=rs.Fields(total_fields-1).value&vbCrLfrs.MoveNextLoop步骤5：关闭记录集rs.CloseSetrs=Nothing步骤6：对Word中的数据进行格式化处理选定文本，将其转换为表格设置视图为普通视图mywdapp.ActiveWindow.View.Type=wdNormalView将光标移动到文档末尾mywdapp.Selection.EndKeyUnit:=wdStory删除文档末尾多余的回车符mywdapp.Selection.DeleteUnit:=wdCharacter,Count:=1选中全部内容mywdapp.Selection.WholeStory将所选内容转换为表格mywdapp.Selection.ConvertToTableSeparator:=wdSeparateByTabs,DefaultTableBehavior:=wdWord8TableBehavior将光标移动到文档开头mywdapp.Selection.HomeKeyUnit:=wdStory选定表格对象SetTemp_Table=mywdapp.ActiveDocument.Tables(1)根据需要对表格进行处理，这是制作表格格式的关键，可反复调试本例只简单地设置了表格居中、自动调整表格列宽、表头居中、标题行重复、设置表格边框线、设置表格纵向居中Temp_Table.Rows.Alignment=wdAlignRowCenterTemp_Table.AutoFitBehaviorwdAutoFitContentTemp_Table.Rows(1).Range.ParagraphFormat.Alignment=wdAlignParagraphCenterTemp_Table.Rows(1).Range.Rows.HeadingFormat=wdToggleTemp_Table.Borders(wdBorderLeft).LineWidth=wdLineWidth150ptTemp_Table.Borders(wdBorderRight).LineWidth=wdLineWidth150ptTemp_Table.Borders(wdBorderTop).LineWidth=wdLineWidth150ptTemp_Table.Borders(wdBorderBottom).LineWidth=wdLineWidth150ptTemp_Table.Range.Cells.VerticalAlignment=wdCellAlignVerticalCenter将光标移动到文档开头mywdapp.Selection.HomeKeyUnit:=wdStory拆分表格mywdapp.Selection.SplitTablemywdapp.Selection.Font.Name=黑体插入标题mywdapp.Selection.TypeTextText:=Title&vbCrLfmywdapp.Application.ScreenRefresh刷屏转到Acdess视图，显示结束对话框mywdapp.Visible=FalseMsg=数据提取完毕。&vbCrLf&vbCrLfMsg=Msg&总记录数=&total_records&条MsgBoxMsg,vbOKOnly,数据提取完毕转到Word视图，显示文档mywdapp.Visible=Truemywdapp.ActivateEndSub方法四：SubWord_ADO()输入表格标题Title=InputBox(vbCrLf&vbCrLf&请输入表格标题：,表格标题,XX公司产品报价单)IfTitle=ThenTitle=XX公司产品报价单步骤1：建立数据连接cnn打开连接,示例数据库：C:ProgramFilesMicrosoftOfficeOfficeSamplesNorthwind.mdbSetcnn=NewADODB.Connectioncnn.Provider=Microsoft.jet.oledb.4.0cnn.OpenC:ProgramFilesMicrosoftOfficeOfficeSamplesNorthwind.mdb步骤2：用SQL语句创建记录集rsSetrs=NewADODB.Recordsetrs.CursorType=adOpenKeysetrs.LockType=adLockOptimisticSQL=select产品名称,单位数量,单价,库存量from产品where单价10.00rs.OpenSQL,cnntotal_fields=rs.Fields.Counttotal_records=rs.RecordCountActiveDocument.Range.Font.Size=9步骤3：将记录集rs中的字段名称和字段内容输出到Word文档，各字段之间用制表符分隔ForI=0Tototal_fields-2Selection.TypeTextText:=rs.Fields(I).Name&vbTabNextISelection.TypeTextText:=rs.Fields(total_fields-1).Name&vbCrLfDoWhileNotrs.EOFForI=0Tototal_fields-2tmpstr=rs.Fields(I).valueIfrs.Fields(I).Name=单价Thentmpstr=Format(tmpstr,#.00)EndIfSelection.TypeTextText:=tmpstr&vbTabNextISelection.TypeTextText:=rs.Fields(total_fields-1).value&vbCrLfrs.MoveNextLoop步骤4：关闭记录集和连接rs.Closecnn.CloseSetrs=NothingSetcnn=Nothing步骤5：对Word中的数据进行格式化处理ActiveWindow.View.Type=wdNormalViewSelection.EndKeyUnit:=wdStorySelection.DeleteUnit:=wdCharacter,Count:=1Selection.WholeStorySelection.ConvertToTableSeparator:=wdSeparateByTabs,DefaultTableBehavior:=wdWord8TableBehaviorSelection.HomeKeyUnit:=wdStorySetTemp_Table=ActiveDocument.Tables(1)Temp_Table.Rows.Alignment=wdAlignRowCenterTemp_Table.AutoFitBehaviorwdAutoFitContentTemp_Table.Rows(1).Range.ParagraphFormat.Alignment=wdAlignParagraphCenterTemp_Table.Rows(1).Range.Rows.HeadingFormat=wdToggleTemp_Table.Borders(wdBorderLeft).LineWidth=wdLineWidth150ptTemp_Table.Borders(wdBorderRight).LineWidth=wdLineWidth150ptTemp_Table.Borders(wdBorderTop).LineWidth=wdLineWidth150ptTemp_Table.Borders(wdBorderBottom).LineWidth=wdLineWidth150ptTemp_Table.Range.Cells.VerticalAlignment=wdCellAlignVerticalCenterSelection.HomeKeyUnit:=wdStorySelection.SplitTableSelection.Font.Name=黑体Selection.TypeTextText:=Title&vbCrLfApplication.ScreenRefreshMsg=数据提取完毕。&vbCrLf&vbCrLfMsg=Msg&总记录数=&total_records&条MsgBoxMsg,vbOKOnly,数据提取完毕EndSub公历农历计算函数Dim WeekName(7), MonthAdd(11), NongliData(99), TianGan(9), DiZhi(11), ShuXiang(11), DayName(30), MonName(12)Dim curTime, curYear, curMonth, curDay, curWeekdayDim GongliStr, WeekdayStr, NongliStr, NongliDayStrDim i, m, n, k, isEnd, bit, TheDatePrivate Sub Form_Load()获取当前系统时间curTime = Now()星期名WeekName(0) = * WeekName(1) = 星期日WeekName(2) = 星期一WeekName(3) = 星期二WeekName(4) = 星期三WeekName(5) = 星期四WeekName(6) = 星期五WeekName(7) = 星期六天干名称TianGan(0) = 甲TianGan(1) = 乙TianGan(2) = 丙TianGan(3) = 丁TianGan(4) = 戊TianGan(5) = 己TianGan(6) = 庚TianGan(7) = 辛TianGan(8) = 壬TianGan(9) = 癸地支名称DiZhi(0) = 子DiZhi(1) = 丑DiZhi(2) = 寅DiZhi(3) = 卯DiZhi(4) = 辰DiZhi(5) = 巳DiZhi(6) = 午DiZhi(7) = 未DiZhi(8) = 申DiZhi(9) = 酉DiZhi(10) = 戌DiZhi(11) = 亥属相名称ShuXiang(0) = 鼠ShuXiang(1) = 牛ShuXiang(2) = 虎ShuXiang(3) = 兔ShuXiang(4) = 龙ShuXiang(5) = 蛇ShuXiang(6) = 马ShuXiang(7) = 羊ShuXiang(8) = 猴ShuXiang(9) = 鸡ShuXiang(10) = 狗ShuXiang(11) = 猪农历日期名DayName(0) = *DayName(1) = 初一DayName(2) = 初二DayName(3) = 初三DayName(4) = 初四DayName(5) = 初五DayName(6) = 初六DayName(7) = 初七DayName(8) = 初八DayName(9) = 初九DayName(10) = 初十DayName(11) = 十?quot;DayName(12) = 十二DayName(13) = 十三DayName(14) = 十四DayName(15) = 十五DayName(16) = 十六DayName(17) = 十七DayName(18) = 十八DayName(19) = 十九DayName(20) = 二十DayName(21) = 廿一DayName(22) = 廿二DayName(23) = 廿三DayName(24) = 廿四DayName(25) = 廿五DayName(26) = 廿六DayName(27) = 廿七DayName(28) = 廿八DayName(29) = 廿九DayName(30) = 三十农历月份名MonName(0) = *MonName(1) = 正MonName(2) = 二MonName(3) = 三MonName(4) = 四MonName(5) = 五MonName(6) = 六MonName(7) = 七MonName(8) = 八MonName(9) = 九MonName(10) = 十MonName(11) = 十一MonName(12) = 腊公历每月前面的天数MonthAdd(0) = 0MonthAdd(1) = 31MonthAdd(2) = 59MonthAdd(3) = 90MonthAdd(4) = 120MonthAdd(5) = 151MonthAdd(6) = 181MonthAdd(7) = 212MonthAdd(8) = 243MonthAdd(9) = 273MonthAdd(10) = 304MonthAdd(11) = 334农历数据NongliData(0) = 2635NongliData(1) = 333387NongliData(2) = 1701NongliData(3) = 1748NongliData(4) = 267701NongliData(5) = 694NongliData(6) = 2391NongliData(7) = 133423NongliData(8) = 1175NongliData(9) = 396438NongliData(10) = 3402NongliData(11) = 3749NongliData(12) = 331177NongliData(13) = 1453NongliData(14) = 694NongliData(15) = 201326NongliData(16) = 2350NongliData(17) = 465197NongliData(18) = 3221NongliData(19) = 3402NongliData(20) = 400202NongliData(21) = 2901NongliData(22) = 1386NongliData(23) = 267611NongliData(24) = 605NongliData(25) = 2349NongliData(26) = 137515NongliData(27) = 2709NongliData(28) = 464533NongliData(29) = 1738NongliData(30) = 2901NongliData(31) = 330421NongliData(32) = 1242NongliData(33) = 2651NongliData(34) = 199255NongliData(35) = 1323NongliData(36) = 529706Nongl