vba教材窗体原创

清空 表 关于同志近三年现实表现材料材料类招标技术评分表图表与交易pdf视力表打印pdf用图表说话 pdf 记录 混凝土 养护记录下载土方回填监理旁站记录免费下载集备记录下载集备记录下载集备记录下载 的方法 以下为需要花5金钱才能购买并浏览的 内容 财务内部控制制度的内容财务内部控制制度的内容人员招聘与配置的内容项目成本控制的内容消防安全演练内容 ，您已经购买本贴 1、CurrentDb().Execute "delete * from 表名" 2、docmd.runsql "SQL语句" 窗体真正居中显示 窗体真正居中显示 如下代码可以做到真正居中显示 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 把子窗体的内容复制到EXCEL[转帖] 来源 HYPERLINK "http://www.accessqq.com" \t "_blank" www.accessqq.com 原作者： 黄海  Sub 把子窗体的内容复制到EXCEL()          Me.Child28.SetFocus    '把焦点移动子窗体上  Child28要操作的子窗体的名称     DoCmd.RunCommand acCmdSelectAllRecords     DoCmd.RunCommand acCmdCopy        Dim obj As Object     Set obj = CreateObject("excel.application")     obj.Workbooks.Add     obj.Visible = True     SendKeys "^v" End Sub 获得窗体/焦点控件信息 来源：ACCESS中国   浪上飞郑 '用screen,下面为帮助里的原代码，还是帮助好用 Sub ActiveObjects()     Dim frm As Form, ctl As Control     ' 返回指向活动窗体的 Form 对象。     Set frm = Screen.ActiveForm     MsgBox frm.Name & " is the active form."     ' 返回指向活动控件的 Control 对象。     Set ctl = Screen.ActiveControl     MsgBox ctl.Name & " is the active control " _         & "on this form." End Sub 打开窗体后进入新增模式 Opening a Form at a new Record There are a couple of ways, depending on how you want your input forms to behave after they've been opened. If you only want to enter records, then in the code to open the form, put this code: DoCmd.OpenForm "frmName", acNormal, ,acFormAdd   If you want to be able to navigate to other records in the form, then put the following code in the OnLoad event for the form: Private Sub Form_Load()     DoCmd.GoToRecord , , acNewRec End Sub  检查数据是否被修改，无则退出，有则询问是否保存 来源：ACCESS交流中心  fatmingli    　  '在窗体的字段的“属性”“事件”“更新后”的右边输入“=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 让access系统窗口的最大化、最小化消失的代码 '新建一个模块。  '在建立一个autoexec宏，“操作”为runcode,参数：启动 ()  '最大化和最小化消失了！  'api声明:  Private Declare Function SetWindowLong Lib "user32" _  Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal _  nIndex As Long, ByVal dwNewLong As Long) As Long  Private Declare Function GetWindowLong Lib "user32" _  Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal _  nIndex As Long) As Long  Const WS_MINIMIZEBOX = &H20000  Const WS_MAXIMIZEBOX = &H10000  Const GWL_STYLE = (-16)  '===============================  '获得活动窗口的句柄  'Declare Function GetActiveWindow Lib "user32" () As Long  '===================  '改变窗体大小  Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long  '使用:  Sub 最大化和最小化按钮消失()  Dim lWnd As Long  lWnd = GetWindowLong(Application.hWndAccessApp, GWL_STYLE)  lWnd = lWnd And Not (WS_MINIMIZEBOX)'最小化  lWnd = lWnd And Not (WS_MAXIMIZEBOX)‘最大化  lWnd = SetWindowLong(Application.hWndAccessApp, GWL_STYLE, lWnd)  End Sub  Public Function 改变窗体大小()  'Application.hWndAccessApp 当前程序的.hwnd  Call 最大化和最小化按钮消失  MoveWindow Application.hWndAccessApp, 20, 20, 600, 400, 1  End Function  窗体上以打字效果显示字符 窗体上以打字效果显示字符 窗体上以打字效果显示字符 来源:不祥 Dim myStr As String Dim myStrLen As Integer Dim i As Integer Private Sub Form_Load() i = 1 myStr = "同仇敌忾，对抗非典！" '"输入需打字的内容" Me.TimerInterval = 300 End Sub Private Sub Form_Timer() myStrLen = Len(myStr) If i > myStrLen Then 标签0.Caption = "" Else 标签0.Caption = Mid(myStr, 1, i) End If '控制循环显示 If i <= myStrLen Then i = i + 1 Else i = 1 End If End Sub 其实这样也可以: Dim myStr As String Dim myStrLen As Integer Dim i As Integer Private Sub Form_Load() i = 1 myStr = "同仇敌忾，对抗非典！" Me.TimerInterval = 300 End Sub Private Sub Form_Timer() myStrLen = Len(myStr) If i > myStrLen Then 标签0.Caption = "" i = 1 Else 标签0.Caption = Mid$(myStr, 1, i) i = i + 1 End If End Sub 让字符走动 Dim strwelcometo As String Private Sub Form_Load()     Me.TimerInterval = 100     strwelcometo = "欢迎使用大通国际运输有限公司发票管理系统   "     Me!WellcomeTo.Caption = strwelcometo End Sub  Private Sub Form_Timer()     Me!WellcomeTo.Caption = Right(strwelcometo, Len(strwelcometo) - 1) & Left(strwelcometo, 1)     strwelcometo = Me!WellcomeTo.Caption      End Sub 让窗体10秒钟自动翻页: Private Sub Form_Load() Me.TimerInterval = 1000 End Sub Private Sub Form_Timer()         Static I As Long            I = I + 1                   If I = 10 Then         Call 命令6_Click         I = 0         End If End Sub Private Sub 命令6_Click() On Error GoTo Err_命令6_Click    DoCmd.GoToRecord , , acNext      Exit_命令6_Click:     Exit Sub Err_命令6_Click:     DoCmd.GoToRecord , , acFirst     Resume Exit_命令6_Click      End Sub 显示的当前记录的记录号 [CurrentRecord]用于显示的当前记录的记录号。 判断记录的位置 来自：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条记录 原创]只显示窗体内容，不显示菜单栏、常用工具栏 '将窗体设为  弹出方式  设为"是" Private Sub Form_Load() docmd.RunCommand acCmdAppMinimize  end sub 分享]窗体内的控件与窗体大小同步变化！ 本示例作者是谁，不记得了，不过试过后很实用的；有一点，只记得原码是加密的，还请各位版主不要宣传！ 一：建一模块 Public Sub ResizeControls(Formular As Form, ByVal StartFormularbreite As Long, ByVal StartFormularh鰄e As Long)     Dim CHANGE_FACTOR As Double     Dim CHANGE_CONTROL As Control         If Not Formular.WindowWidth = 0 Then                 CHANGE_FACTOR = Formular.WindowWidth / StartFormularbreite                         If Not CHANGE_FACTOR = 1 Then                     On Error Resume Next             If CHANGE_FACTOR > 1 Then                 Formular.Section(0).Height = Formular.Section(0).Height * CHANGE_FACTOR                 Formular.Section(1).Height = Formular.Section(1).Height * CHANGE_FACTOR                 Formular.Section(2).Height = Formular.Section(2).Height * CHANGE_FACTOR             End If             For Each CHANGE_CONTROL In Formular.Controls                             If CHANGE_CONTROL.ControlType = acSubform Then                     Dim UFOBREITE As Integer                     Dim UFOHREITE As Integer                     UFOBREITE = CHANGE_CONTROL.Width                     UFOHREITE = CHANGE_CONTROL.Height                     CHANGE_CONTROL.Width = CHANGE_CONTROL.Width * CHANGE_FACTOR                     CHANGE_CONTROL.Height = CHANGE_CONTROL.Height * CHANGE_FACTOR                     CHANGE_CONTROL.Top = CHANGE_CONTROL.Top * CHANGE_FACTOR                     CHANGE_CONTROL.Left = CHANGE_CONTROL.Left * CHANGE_FACTOR                     ResizeControls CHANGE_CONTROL.Form, UFOBREITE, UFOHREITE                 Else                     CHANGE_CONTROL.Width = CHANGE_CONTROL.Width * CHANGE_FACTOR                     CHANGE_CONTROL.Height = CHANGE_CONTROL.Height * CHANGE_FACTOR                     CHANGE_CONTROL.Top = CHANGE_CONTROL.Top * CHANGE_FACTOR                     CHANGE_CONTROL.Left = CHANGE_CONTROL.Left * CHANGE_FACTOR                     CHANGE_CONTROL.FontSize = CHANGE_CONTROL.FontSize * CHANGE_FACTOR                 End If                                     Next                         　　　If CHANGE_FACTOR < 1 Then                 Formular.Section(0).Height = Formular.Section(0).Height * CHANGE_FACTOR                 Formular.Section(1).Height = Formular.Section(1).Height * CHANGE_FACTOR                 Formular.Section(2).Height = Formular.Section(2).Height * CHANGE_FACTOR             End If                         Formular.Repaint                         On Error GoTo 0                 End If         End If End Sub 二、应用： Option Compare Database Option Explicit Dim Form_Start_Height As Long Dim Form_Start_Width As Long Dim Form_Current_Height As Long Dim Form_Current_Width As Long Private Sub Form_Open(Cancel As Integer)     Form_Start_Height = Me.WindowHeight     Form_Start_Width = Me.WindowWidth     Form_Current_Height = Me.WindowHeight     Form_Current_Width = Me.WindowWidth  End Sub Private Sub Form_Resize()     ResizeControls Me, Form_Current_Width, Form_Current_Height     Form_Current_Height = Me.WindowHeight     Form_Current_Width = Me.WindowWidth End Sub 对话框返回文本框内容 InputBox(prompt[, title] [, default] [, xpos] [, ypos] [, helpfile, context]) InputBox 函数的语法具有以下几个命名参数： Prompt：必需的。作为对话框消息出现的字符串表达式。prompt 的最大长度大约是 1024 个字符，由所用字符的宽度决定。如果 prompt 包含多个行，则可在各行之间用回车符 (Chr(13))、换行符 (Chr(10)) 或回车换行符的组合 (Chr(13) & Chr(10)) 来分隔。 Title：可选的。显示对话框标题栏中的字符串表达式。如果省略 title，则把应用程序名放入标题栏中。 Default：可选的。显示文本框中的字符串表达式，在没有其它输入时作为缺省值。如果省略 default，则文本框为空。 Xpos：可选的。数值表达式，成对出现，指定对话框的左边与屏幕左边的水平距离。如果省略 xpos，则对话框会在水平方向居中。 Ypos：可选的。数值表达式，成对出现，指定对话框的上边与屏幕上边的距离。如果省略 ypos，则对话框被放置在屏幕垂直方向距下边大约三分之一的位置。 Helpfile：可选的。字符串表达式，识别帮助文件，用该文件为对话框提供上下文相关的帮助。如果已提供 helpfile，则也必须提供 context。 Context: 可选的。数值表达式，由帮助文件的作者指定给某个帮助主题的帮助上下文编号。如果已提供 context，则也必须要提供 helpfile。 示例： 本示例说明使用 InputBox 函数来显示用户输入数据的不同用法。如果省略 x 及 y 坐标值，则会自动将对话框放置在两个坐标的正中。如果用户单击“确定”按钮或按下“ENTER”按键，则变量 Myvalue 保存用户输入的数据。如果用户单击“取消”按钮，则返回一零长度字符串。 Dim Message, Title, Default, Myvalue Message = "Enter a value between 1 and 3"    ' 设置提示信息。 Title = "InputBox Demo"    ' 设置标题。 Default = "1"    ' 设置缺省值。 ' 显示信息、标题及缺省值。 Myvalue = InputBox(Message, Title, Default) ' 使用帮助文件及上下文。“帮助”按钮便会自动出现。 Myvalue = InputBox(Message, Title, , , , "DEMO.HLP", 10) ' 在 100, 100 的位置显示对话框。 Myvalue = InputBox(Message, Title, Default, 100, 100) 用代码使ACCESS主窗体上的“X”失效 来源：Alex 曾经有人问过这个问题，是为了防止用户不按正常程序退出。  在程序开始的窗体里加入：  Private Declare Function GetSystemMenu Lib "User32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long  Private Declare Function DeleteMenu Lib "User32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long  Private Sub FORM_Load()  　　Const MF_BYCOMMAND = &H0&  　　Const SC_CLOSE = &HF060  　　Dim hMenu As Long  　　  　　hMenu = GetSystemMenu(Application.hWndAccessApp, 0)  　　  　　Call DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND)  　　  End Sub  在ACCESS 2000中通过测试，97和XP没有测试过。 [原创]根据屏幕分辨率自动调整窗体大小：[ Option Compare Database Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Const SM_CXSCREEN = 0 Private Const SM_CYSCREEN = 1 Private Sub Form_Open(Cancel As Integer) Dim x As Long, y As Long, a As Long, b As Long x = GetSystemMetrics(SM_CXSCREEN) y = GetSystemMetrics(SM_CYSCREEN) a = 10000 / 800 * x b = 7000 / 600 * y DoCmd.MoveSize 1134, 1134, a, b End Sub 窗口增加时钟 窗口增加时钟 ***************** Code Start *************** Private Sub Form_Timer() Me!lblClock.Caption = Format(Now, "dddd, mmm d yyyy, hh:mm:ss AMPM") End Sub Private Sub cmdClockStart_Click() Me.TimerInterval = 1000 End Sub Private Sub cmdClockEnd_Click() Me.TimerInterval = 0 End Sub 在一个窗体中刷新另一个窗体中的控件代码 Forms!窗体名.Form.控件名.Requery 变更窗体图标 来源：tehthspace.accxp.com  Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, _ ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, _ ByVal un2 As Long) As Long Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _ ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Const WM_SETICON = &H80 Const IMAGE_ICON = 1 Const LR_LOADFROMFILE = &H10 Function SetFormIcon(hwnd As Long, IconPath As String) As Boolean On Error GoTo Exit_ERR Dim hIcon As Long hIcon = LoadImage(0&, IconPath, IMAGE_ICON, 16, 16, LR_LOADFROMFILE) If hIcon <> 0 Then Call SendMessage(hwnd, WM_SETICON, 0, ByVal hIcon) SetFormIcon = True Else End End If Exit_ERR: Exit Function End Function 如何让窗体大小固定(不用弹出窗体,不影响其他窗体) 来源：爱赛思应用俱乐部 tanyiqiang 用 对话框 边框。  在一个窗体中执行另一窗体的子程序 来源：爱赛思应用俱乐部 huanghai DoCmd.OpenForm "窗体2"     Call Forms("窗体2").aaa 用其他ACCESS的表作为本ACCESS 窗体的数据源 来源：ACCESS中国 Trynew 在Sql语句中的表名前加上数据库名就行了，下面语句动态引用当前目录的另一MDB文件的表做数据源： Private Sub Form_Load()     Me.RecordSource = "SELECT 表1.* FROM [" & CurrentProject.Path & "\db1.mdb" & "].表1;" End Sub 让窗体在几秒钟自动打开. Private Sub Form_Open(Cancel As Integer)     Me.TimerInterval = 5000 End Sub Private Sub Form_Timer()     DoCmd.Close acForm, Me.Name     DoCmd.OpenForm ("主切换面板") End Sub 两个子窗体记录根据记录号同步移动的一个方法 原创：Trynew 子窗体1与子窗体2的记录以1:2的步长移动， 把下列代码分别添加到子窗体模块中： Subform1:  Private Sub Form_Current() On Error Resume Next If Me.Parent.ActiveControl.Name = Me.Name Then Me.Parent.subform2.Form.Recordset.Move Me.CurrentRecord * 2 - 1 - Me.Parent.subform2.Form.CurrentRecord End If End Sub Subform2 Private Sub Form_Current() On Error Resume Next If Me.Parent.ActiveControl.Name = Me.Name Then Me.Parent.Subform1.Form.Recordset.Move (Me.CurrentRecord + 1) \ 2 - Me.Parent.Subform1.Form.CurrentRecord End If End Sub 用代码隐藏、最大化、最小化ACCESS的主窗口 怎样用代码隐藏、最大化、最小化ACCESS的主窗口 作 者：朱亦文(译)  摘 要：该函数能用来完全隐藏 Access 窗口并将你自己的窗体显示在桌面上。在弹出式窗体的 Open 事件中使用 SW_HIDE 参数调用 fSetAccessWindow 函数实现。 正 文： (问)　 怎样用代码隐藏、最大化、最小化ACCESS的主窗口?  (答)　 通过一函数已定义的常量 fSetAccessWindow 实现。  该函数能用来完全隐藏 Access 窗口并将你自己的窗体显示在桌面上。在弹出式窗体的 Open 事件中使用 SW_HIDE 参数调用 fSetAccessWindow 函数实现。  注意：如果你隐藏了 Access 主窗口，要确定你有良好的出错处理。因为主窗口隐藏后，一旦引发错误，并出错提示窗口上点击了“结束”按钮，这样不会使 Access 主窗口可见，并退出你自己的窗体。推荐你在你的错误处理程序中使用 SW_SHOWNORMAL 参数调用 fSetAccessWindow 函数来显示 Access 主窗口。  如果由于别的原因，Access 主窗口不能显示，那么你将只能从任务栏中关闭你的 mdb，在 Win 9x 中使用 Control-Alt-Delete 来结束任务，在 Win NT 、2000 或 XP 中，可以右键单击任务栏选择任务管理器来选择该 mdb 结束任务。  '************ 代码开始 **********  Global Const SW_HIDE = 0  Global Const SW_SHOWNORMAL = 1  Global Const SW_SHOWMINIMIZED = 2  Global Const SW_SHOWMAXIMIZED = 3  Private Declare Function apiShowWindow Lib "user32" _  　　Alias "ShowWindow" (ByVal hwnd As Long, _  　　　　　ByVal nCmdShow As Long) As Long  Function fSetAccessWindow(nCmdShow As Long)  ' 使用举例  ' 最大化 Access 窗口  '　　　 ?fSetAccessWindow(SW_SHOWMAXIMIZED)  ' 最小化 Access 窗口  '　　　 ?fSetAccessWindow(SW_SHOWMINIMIZED)  ' 隐藏 Access 窗口  '　　　 ?fSetAccessWindow(SW_HIDE)  ' 正常显示 Access 窗口  '　　　 ?fSetAccessWindow(SW_SHOWNORMAL)  '  Dim loX　As Long  Dim loFORM As FORM  　　On Error Resume Next  　　Set loFORM = Screen.ActiveFORM  　　If Err <> 0 Then ' 没有活动窗体 no ActiveFORM  　　　If nCmdShow = SW_HIDE Then  　　　　MsgBox "除非屏幕上有一个窗口，否则不能隐藏 Access 主窗口!" _  　　　　　　　　　　& vbcr & vbcr　_  　　　　　　　　　　& "Cannot hide Access unless " _  　　　　　　　　　　& "a FORM is on screen"  　　　Else  　　　　loX = apiShowWindow(hWndAccessApp, nCmdShow)  　　　　Err.Clear  　　　End If  　　Else  　　　　If nCmdShow = SW_SHOWMINIMIZED And loFORM.Modal = True Then  　　　　　　MsgBox "不能由屏幕上的 " & (loFORM.Caption + " ")　& "窗体最小化 Access 主窗口!" _  　　　　　　　　　　& vbcr & vbcr　_  　　　　　　　　　　& "Cannot minimize Access with " _  　　　　　　　　　　& (loFORM.Caption + " ") _  　　　　　　　　　　& "FORM on screen"  　　　　ElseIf nCmdShow = SW_HIDE And loFORM.PopUp <> True Then  　　　　　　MsgBox "不能由屏幕上的 " & (loFORM.Caption + " ")　& "窗体隐藏 Access 主窗口!" _  　　　　　　　　　　& vbcr & vbcr　_  　　　　　　　　　　& "Cannot hide Access with " _  　　　　　　　　　　& (loFORM.Caption + " ") _  　　　　　　　　　　& "FORM on screen"  　　　　Else  　　　　　　loX = apiShowWindow(hWndAccessApp, nCmdShow)  　　　　End If  　　End If  　　fSetAccessWindow = (loX <> 0)  End Function  恢复默认菜单和工具栏的办法 作者：朱亦文 恢复默认菜单和工具栏的办法 引用 microsoft office 9.0 object library 执行如下过程： public sub enabledefaultmenu() dim obar as commandbar set obar = commandbars("menu bar") obar.reset end sub 恢复默认菜单和工具栏，搞定！ 注：menu bar是指access的主菜单 隐藏当前激活的工具条 Dim dqgjt As Variant Set dqgjt = CommandBars.ActiveMenuBar dqgjt.Enabled = False 判断窗体是否打开的两种方法 判断窗体是否打开的两种方法 判断窗体是否打开的两种方法 Function IsLoaded(strName As String, Optional intObjectType As Integer = acForm) IsLoaded = (SysCmd(acSysCmdGetObjectState, intObjectType, strName) <> 0) End Function 函数二 Function IsFormLoaded(strFrmName As String) As Boolean Const conFormDesign = 0 Dim intX As Integer IsFormLoaded= False For intX = 0 To Forms.Count - 1 If Forms(intX).FormName = strFrmName Then If Forms(intX).CurrentView <> conFormDesign Then IsFormLoaded= True Exit Function ' Quit function once form has been found. End If End If Next 更新数据时保存提示操作员 更新数据时保存提示操作员 Private Sub Form_BeforeUpdate(Cancel As Integer) Dim strMsg As String strMsg = "Data has changed." strMsg = strMsg & "@Do you wish to save the changes?" strMsg = strMsg & "@Click Yes to Save or No to Discard changes." If MsgBox(strMsg, vbQuestion + vbYesNo, "Save Record?") = vbYes Then 'do nothing Else DoCmd.RunCommand acCmdUndo 'For Access 95, use DoMenuItem instead 'DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70 End If End Sub ‘子窗口无数据时,隐藏  '*********** Code Start ********** Private Sub Form_Current() With Me![SubformName].Form .Visible = (.RecordsetClone.RecordCount > 0) End With End Sub  制窗体的垂直滚动条的显示与否的代码 控制窗体的垂直滚动条的显示与否的代码 来源：ACCESS 中国 李寻欢 不显示：Me.ScrollBars = 0 全部显示：Me.ScrollBars = 3 显示水平：Me.ScrollBars = 1 显示垂直：Me.ScrollBars = 2  打开与关闭窗体的函数 打开与关闭窗体的函数 将一些常用命令写成函数，以简化您的程序 如关闭窗体指令可将之写成以下形式放在模块中 Function strCloseForm(strFormName As String) As String  On Error GoTo strCloseForm_Err  　  　　DoCmd.Close acForm, strFormName  strCloseForm_Exit:  　Exit Function  strCloseForm_Err:  　MsgBox Error$  　Resume strCloseForm_Exit  End Function 调用方法：关闭本窗体 strCloseForm(Me.Name) 　　　　 关闭其它窗体 strCloseForm("FormName")  如何取两个文本框中的最大值 如何取两个文本框中的最大值 本站原创： 问:  在窗体中,同一个记录里有两个字段是数值,新增一个文本框,文本框的值是两个字段中的最大值,那么该文本框的函数该怎样设置? 如:  字段 A B 值 10 8 新增字段 C ,那么C字段在该记录中的值就是10,如何设置C字段文本框? 答：C=iif(A>B,A,B)'意思是如果A>B，则C=A，否则C=B 隐藏主窗口 隐藏主窗口 Global Const SW_HIDE = 0 Global Const SW_SHOWNORMAL = 1 Global Const SW_SHOWMINIMIZED = 2 Global Const SW_SHOWMAXIMIZED = 3 ' 使用举例 ' 最大化 Access 窗口 ' ?fSetAccessWindow(SW_SHOWMAXIMIZED) ' 最小化 Access 窗口 ' ?fSetAccessWindow(SW_SHOWMINIMIZED) ' 隐藏 Access 窗口 ' ?fSetAccessWindow(SW_HIDE) ' 正常显示 Access 窗口 ' ?fSetAccessWindow(SW_SHOWNORMAL) ' Option Compare Database Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long Function fSetAccessWindow(nCmdShow As Long) Dim loX As Long Dim loForm As Form On Error Resume Next loX = apiShowWindow(hWndAccessApp, nCmdShow) Err.Clear fSetAccessWindow = (loX <> 0) End Function Private Sub Form_Load() Dim yhsfm As String yhsfm = CurrentUser() If yhsfm <> "ylw" Then Dim X X = fSetAccessWindow(0) End If End sub 如何设置窗体左上角的图标？ 如何设置窗体左上角的图标？ 方法很多，这里介绍3种： 方法一： 在菜单中设置， 工具 -> 启动 -> 应用程序图标 如果在“用作窗体和报表的图标”前面打勾，那么你的这个access数据库中所有的窗体和报表的图标都会一致 方法二： 用api，代码如下： There are no direct way to place a custom icon in a form's caption bar. However, by loading an ICO file into memory, we can assign the icon to a form by sending a WM_SETICON message to the window. '*********** Code Start ******** 'Code courtesy of 'Klaus H. Probst ' '// Place all this in a module Public Declare Function LoadImage Lib "user32" _ Alias "LoadImageA" _ (ByVal hInst As Long, _ ByVal lpsz As String, _ ByVal un1 As Long, _ ByVal n1 As Long, _ ByVal n2 As Long, _ ByVal un2 As Long) _ As Long Public Declare Function SendMessage Lib "user32" _ Alias "SendMessageA" _ (ByVal hWnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ LParam As Any) _ As Long Public Const WM_GETICON = &H7F Public Const WM_SETICON = &H80 Public Const ICON_SMALL = 0 Public Const ICON_BIG = 1 '// LoadImage() image types Public Const IMAGE_BITMAP = 0 Public Const IMAGE_ICON = 1 Public Const IMAGE_CURSOR = 2 Public Const IMAGE_ENHMETAFILE = 3 '// LoadImage() flags Public Const LR_DEFAULTCOLOR = &H0 Public Const LR_MONOCHROME = &H1 Public Const LR_COLOR = &H2 Public Const LR_COPYRETURNORG = &H4 Public Const LR_COPYDELETEORG = &H8 Public Const LR_LOADFROMFILE = &H10 Public Const LR_LOADTRANSPARENT = &H20 Public Const LR_DEFAULTSIZE = &H40 Public Const LR_LOADMAP3DCOLORS = &H1000 Public Const LR_CREATEDIBHeader = &H2000 Public Const LR_COPYFROMRESOURCE = &H4000 Public Const LR_SHARED = &H8000 Public Function SetFormIcon(hWnd As Long, IconPath As String) As Boolean Dim hIcon As Long hIcon = LoadImage(0&, IconPath, IMAGE_ICON, 16, 16, LR_LOADFROMFILE) '// wParam = 0; Setting small icon. wParam = 1; setting large icon If hIcon <> 0 Then Call SendMessage(hWnd, WM_SETICON, 0, ByVal hIcon) SetFormIcon = True End If End Function '*********** Code Start ******** '翻译成中文如下： 没有一个直接的办法为窗体设置自己的图标，然而, 通过加载图标文件到内存,  然后通过发送WM_SETICON 消息到这个窗体来指定这个窗体的图标 '*********** 代码开始 ******** 'Code courtesy of 'Klaus H. Probst ' '// 引用API 函数loadimage及 sendmessage Public Declare Function LoadImage Lib "user32" _ Alias "LoadImageA" _ (ByVal hInst As Long, _ ByVal lpsz As String, _ ByVal un1 As Long, _ ByVal n1 As Long, _ ByVal n2 As Long, _ ByVal un2 As Long) _ As Long Public Declare Function SendMessage Lib "user32" _ Alias "SendMessageA" _ (ByVal hWnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ LParam As Any) _ As Long Public Const WM_GETICON = &H7F Public Const WM_SETICON = &H80 Public Const ICON_SMALL = 0 Public Const ICON_BIG = 1 '// LoadImage() image types '指定了欲载入的图象类型：IMAGE_BITMAP， IMAGE_CURSOR， IMAGE_ICON  Public Const IMAGE_BITMAP = 0 Public Const IMAGE_ICON = 1 Public Const IMAGE_CURSOR = 2 Public Const IMAGE_ENHMETAFILE = 3 '// LoadImage() 参数 'LR_DEFAULTCOLOR 以常规方式载入图象  'LR_LOADREALSIZE 不对图象进行缩放处理。忽略n1和n2的设置  'LR_CREATEDIBSECTION 如果指定了IMAGE_BITMAP，就返回DIBSection的句柄，而不是位图  的句柄  'LR_DEFAULTSIZE 如果n1和n2为零，就使用由系统定义的图象默认大小，而不是图象本身  定义的大小  'LR_LOADFROMFILE 如hInst为零，lpsz就代表要载入适当类型的一个文件的名字，仅适用  于Win95  'LR_LOADMAP3DCOLORS 将图象中的深灰、灰、以及浅灰像素都替换成COLOR_3DSHADOW，  COLOR_3DFACE以及COLOR_3DLIGHT的当前设置  'LR_LOADTRANSPARENT 与图象中第一个像素相符的所有像素都由系统替换  'LR_MONOCHROME 将图象转换成单色  'LR_SHARED 将图象作为一个共享资源载入。在NT 4.0中装载固有资源时要用到这个设置  Public Const LR_DEFAULTCOLOR = &H0 Public Const LR_MONOCHROME = &H1 Public Const LR_COLOR = &H2 Public Const LR_COPYRETURNORG = &H4 Public Const LR_COPYDELETEORG = &H8 Public Const LR_LOADFROMFILE = &H10 Public Const LR_LOADTRANSPARENT = &H20 Public Const LR_DEFAULTSIZE = &H40 Public Const LR_LOADMAP3DCOLORS = &H1000 Public Const LR_CREATEDIBHeader = &H2000 Public Const LR_COPYFROMRESOURCE = &H4000 Public Const LR_SHARED = &H8000 Public Function SetFormIcon(hWnd As Long, IconPath As String) As Boolean Dim hIcon As Long hIcon = LoadImage(0&, IconPath, IMAGE_ICON, 16, 16, LR_LOADFROMFILE) '载入一个位图、图标或指针 (上面使用小图标） '返回值 执行成功则返回对象的一个句柄；零表示失败  If hIcon <> 0 Then '如果成功则设置窗体图标 Call SendMessage(hWnd, WM_SETICON, 0, ByVal hIcon) '设置窗体图标 SetFormIcon = True '返回设置成功 End If End Function '*********** 代码结束 ******** 方法三： Access本身有代码可以定义 先定义以下函数： Function AddAppProperty(strName As String, varType As Variant, varvalue As Variant) As Integer Dim dbs As Object, prp As Variant Const conPropNotFoundError = 3270 Set dbs = CurrentDb On Error GoTo AddProp_Err dbs.Properties(strName) = varvalue AddAppProperty = True AddProp_Bye: Exit Function AddProp_Err: If Err = conPropNotFoundError Then Set prp = dbs.CreateProperty(strName, varType, varvalue) dbs.Properties.append prp Resume Else AddAppProperty = False Resume AddProp_Bye End If End Function 然后用以下语句调用 AddAppProperty "AppIcon", DB_Text, Application.CurrentProject.Path & "\icon.ICO" 方法四： 在ACCESS中没有一个直接的办法为窗体设置自己的图标，但是, 可以通过Wondows API的LoadImage加载图标文件到内存, 通过SendMessage发送WM_SETICON消息到这个窗体，来指定这个窗体的图标。 首先新建一个模块，添加Windows API函数定义如下： Public Declare Function LoadImage Lib "user32" Alias "LoadImageA" _ (ByVal hInst As Long, _ ByVal lpsz As String, _ ByVal un1 As Long, _ ByVal n1 As Long, _ ByVal n2 As Long, _ ByVal un2 As Long) _ As Long Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hWnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ LParam As Any) _ As Long  定义API要使用的常量如下：  Public Const WM_SETICON = &H80 Public Const IMAGE_ICON = 1 Public Const LR_LOADFROMFILE = &H10  更改窗体图标的函数 Public Function SetFormIcon(hWnd As Long, IconPath As String) As Boolean ' 调用方式 ' 例： intX = SetFormIcon(Me.hWnd, strPicPath) Dim hIcon As Long ' 加载 16X16 图标到内存 hIcon = LoadImage(0&, IconPath, IMAGE_ICON, 16, 16, LR_LOADFROMFILE) ' 返回值 执行成功则返回对象的一个句柄；零表示失败 If hIcon <> 0 Then '如果成功则设置窗体图标 ' 发送消息，设置窗体图 Call SendMessage(hWnd, WM_SETICON, 0, ByVal hIcon)标 SetFormIcon = True '返回设置成功 Else SetFormIcon = False End If End Function 在程序中使用 例如：把当前窗体的图标改 C:\my.ico 一般在窗体的加载事件处理程序中书写更改窗体的程序 Private Sub Form_Load() Dim intX intX = SetFormIcon(Me.hWnd, "C:\my.ico") End Sub  让获得焦点的字段自动改变背景颜色 让获得焦点的字段自动改变背景颜色 如果你的控件是文本框，名称为“txt字段”，写如下代码： Private Sub txt字段_GotFocus() 　Me.txt字段.BackColor = 12632256 End Sub 当中“12632256”是灰色，你可以自己选择希望的颜色，如果想在失去焦点时改为原来的颜色，写如下代码： Private Sub txt字段_LostFocus() 　Me.txt字段.BackColor = 16777215 End Sub 窗体上所有控件的输入法关掉! 窗体上所有控件的输入法关掉! 将窗体上所有控件的输入法关掉! 来源:不祥 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进窗体就可以了 常量 控件  acBoundObjectFrame 绑定对象框  acCheckBox 复选框  acComboBox 组合框  acCommandButton 命令按钮  acCustomControl ActiveX（自定义）控件  acImage 图像  acLabel 标签  acLine 线条  acListBox 列表框  acObjectFrame 未绑定对象框或图表  acOptionButton 选项按钮  acOptionGroup 选项组  acPage 页  acPageBreak 分页符  acRectangle 矩形  acSubform 子窗体/子报表  acTabCtl 选项卡  acTextBox 文本框  acToggleButton 切换按钮 设置ListBox的水平卷动轴的宽度 设置ListBox的水平卷动轴的宽度 如何设置ListBox的水平卷动轴的宽度？ ' API函数声明 Const LB_SETHORIZONTALEXTENT = &H194 Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _ lParam As Any) As Long  ' 调用 Call SendMessage(List1.hwnd, LB_SETHORIZONTALEXTENT, 400, ByVal 0&)  ' 注意400是以象素为单位，你可以根据情况自行设定。  如何使你的标签闪烁以引人注意 如何使你的标签闪烁以引人注意 来源：ACCESS中国 tmtony 设置窗体的TimerInterval 值为1000 (1秒). forms OnTimer 加入代码: Sub Form_Timer() YourTextLabel.Visible = Not YourTextLabel.Visible End_Sub 窗体无数据自动关闭 窗体无数据自动关闭 来源：爱赛思应用俱乐部 tanyiqiang  Private Sub FORM_Open(Cancel As Integer)  　　If Me.Recordset.RecordCount = 0 Then  　　　　Cancel = True  　　End If  End Sub  怎样使窗体一打开就定位到指定记录上 怎样使窗体一打开就定位到指定记录上 定义一个变量lngbh，要窗体打开时显示ID=Lngbh的这条记录。 DoCmd.OpenForm "formname", acNormal, , "ID =" & LNGBH, acFormEdit, acWindowNormal 如何在ACCESS之窗体中删除记录，但显示自订对话框？ 如何在ACCESS之窗体中删除记录，但显示自订对话框？ 来源：ACCESS交流中心 huang59 一般在ACCESS内删除记录时，ACCESS会显示预设对话框，确认删除动作，若要显示自订对话框，可在窗体之BeforeDelConfirm事件程序拦截删除动作，BeforeDelConfirm事件程序提供两个参数，Response表示如何控制预设对话框，acDataErrContinue表示不显示预设对话框，若Response= acDataErrDisplay，则表示显示预设对话框，Cancel=True则表示中止删除动作，也就不删除，因使用者已按下「否」按钮。若按下「是」按钮，则会继续发生AfterDelConfirm事件，同时删除记录。  TextBox 限制只能输入数字 TextBox 限制只能输入数字 来源：老怪 Private Sub Text1_KeyPress(KeyAscii As Integer) 'KeyAscii 32 以下是一些控制键，拦接会造成操作障碍 If KeyAscii >= 33 Then If KeyAscii <= vbKey9 And KeyAscii>= vbKey0 Then Else '把 KeyAscii 設為 0 就是取消輸入 KeyAscii = 0 MsgBox "不可輸入非數字字元" End If End If End Sub 解說： KeyAscii 之键码同於 KeyCode 之鍵碼，你可以查 VB 說明之 KeyCode 一項，但有些Keycode 鍵碼一定要在 KeyDown 和 KeyUp 裏才收的到，在 KeyPress 的 KeyAscii裏收不到。  利用 KeyAscii =0 的方式在 KeyPress 裏有用，在 KeyDown 裏把 KeyCode=0 可就不管用了，所以 Down,Press,Up 各有各的用處，要分清楚才好。  TextBox 限制输入长度 TextBox 限制输入长度 来源：www.hosp.ncku.edu.tw/~cww/oldguy/oldguy.htm 寄件者: Annie Chiu  在VB中使用text 的maxlength 屬性,我的資料欄位長度為10, 如何控制text 只能輸入10個英文字, 或5個中文字呢？ 老怪答： 用 textbox.maxlength 的屬性，它還是會把兩 byte 的中文算一個字，你參考下面的程式碼，或許能達成你的目標。  Private Sub Text1_Change() Static OldString As String If LenB(StrConv(Text1.Text, vbFromUnicode)) > 10 Then Text1.Text = OldString End If OldString = Text1.Text End Sub  ComboBox 的使用技巧 ComboBox 的使用技巧 来源：www.hosp.ncku.edu.tw/~cww/oldguy/oldguy.htm iroi 撰寫於文章  請問各位,vb的combo box怎用的 老怪答： 在做 Combobox的判斷時，有幾個要注意配合使用的屬性是 .List  text  listindex  newindex  listcount  取出 ComboBox 裏的值 '------ 列出 combobox 所有 list 值  for i=0 to combobox.listcount-1  debug.print combobox.list(i)  next  '------取出以滑鼠點選值 Private Sub Combo1_Click()  debug.print combo1.list(combo1.listindex)  End Sub  '-----取出新加入的值 combo1.addnew "XXXXXX"  debug.print combo1.list(combo1.newindex)  '---- 將組合式文字框加入 Combo1 Private Sub Combo1_KeyPress(KeyAscii As Integer)  If KeyAscii = 13 Then  combo1.addnew combo1.text  End If  End Sub  格式 pdf格式笔记格式下载页码格式下载公文格式下载简报格式下载 刷和粘贴控件 格式刷和粘贴控件 　 格式刷  单击工具栏上的“格式刷”按钮，鼠标将变成。如果要将相同的格式特性应用到几个控件中，请双击该按钮将其锁定，按鼠标右键取消格式刷。只能从单个的控件中复制特性。 在要要粘贴格式特性的控件上单击，可以单击同类型的控件，也可以选择另一种类型控件。例如，可以从文本框中将格式特性复制到列表框中。 Microsoft Access 将复制下列任一项属性：SpecialEffect（特殊效果）、 BorderStyle（边框样式）、 BorderColor（边框颜色）、 BorderWidth（边框宽度）、 BackColor（背景颜色）、 BackStyle（背景样式）、 FontName（字体）、 FontSize（字号）、FontWeight（字样粗细）、 ForeColor（前景颜色）、 FontItalic（斜体）、 FontUnderline（下划线）、Visible（可见性）、 DisplayWhen（何时显示）、 对于标签控件，还将复制 LabelAlign（标签对齐）属性； 对于文本框控件，还将复制 TextAlign（文本对齐）属性； 对于直线控件，还将复制 LineSlant（斜线）属性。 　 粘贴控件 你可以确定被粘贴的控件的位置。如果选择某一节，Microsoft Access 将把控件贴在该节的左上角。如在要粘贴的区域附近选定了控件，则 Microsoft Access 将把控件贴在选定控件的下方。但是请注意，如果粘贴标签，而且所选定的控件并没有附属标签，Microsoft Access 将把标签附属到选定的控件。 另外，Microsoft Access 不会复制与控件有关系的事件过程。  如何使非可用的控件不显示成灰色 如何使非可用的控件不显示成灰色 如何使非可用的控件不显示成灰色 作 者：朱亦文  发布日期：2002年10月27日  摘 要：当在窗体放上一个文本框或其它用以输入数据的控件，有的时候我们并不想用它来输入数据，而仅只是为了显示，与其它控件统一风格。意思就是说，不可编辑该控件的值。而控件不可用时是灰色的,哪怎么办呢?本文将为你解决这一问题。 正 文： 当在窗体放上一个文本框或其它用以输入数据的控件，有的时候我们并不想用它来输入数据，而仅只是为了显示，与其它控件统一风格。意思就是说，不可编辑该控件的值。 一般采用的办法是，设置其属性［是否有效］(Enabled)为［否］(False)，这时，该控件就得不到焦点了，当然也就不能编辑它的值。可是，这时控件显示的是灰色的不可用的底色，造成与 设计 领导形象设计圆作业设计ao工艺污水处理厂设计附属工程施工组织设计清扫机器人结构设计 时的颜色不一致，破坏了美观，怎么办呢？ 解决的办法，就是，将该控件的［是否锁定］(Locked)属性设为［是］(True)，即可。 实现子窗体全选功能 实现子窗体全选功能 Private Sub 复选3_AfterUpdate() Dim rs As ADODB.Recordset, strSQL As String Set rs = New ADODB.Recordset strSQL = "SELECT 是否打印 FROM 表1;" rs.Open strSQL, CurrentProject.Connection, adOpenStatic, adLockPessimistic If Not rs.EOF Then rs.MoveFirst Do While Not rs.EOF rs(0).value = 复选3.value rs.MoveNext Loop rs.Close Set rs = Nothing 子对象1.Requery End Sub 让用户不能随意退出(退出前提示)！ 让用户不能随意退出(退出前提示)！ 建立一个窗体，名字叫隐藏，并在启动选项内选定这个窗体为启动时自动打开。 然后在窗体的加载事件内加入如下代码： Private Sub Form_Load() Me.Visible = False End Sub ''在窗体的卸载事件中加入如下代码： Private Sub Form_Unload(Cancel As Integer) If MsgBox("你真的要退出吗？", vbYesNo + vbQuestion, "请确认…") = vbNo Then Cancel = True End Sub 在窗体上显示子窗体中的合计数 在窗体上显示子窗体中的合计数 在主窗体显示合计的文本框中直接这样填写就行啦！假设，您要统计的字段名称为：Tcount，该字段所在的表名称为：TableAA，主索引字段名称为Tindex  =Dsum("Tcount","TableAA","Tindex='" & [Tindex] & "'") 图像作窗体背景，让图像大小和窗体的大小保持一致 图像作窗体背景，让图像大小和窗体的大小保持一致。 在FORM_load 和FORM_resize 里加上　 图片.width=me.windowwidth  图片.height=me.windowheight 来源：爱赛思应用网。 按特殊名在VBA中设置控件的可见性 按特殊名在VBA中设置控件的可见性 For i = 27 To 47 If Me.Controls.Item(i).Name Like "A*" Then Me.Controls.Item(i).Visible = False End If Next 在多页窗体中用按钮翻页 在多页窗体中用按钮翻页 上一页 Private Sub 上一页_Click() DoCmd.GoToPage 1 End Sub 下一页 Private Sub 下一页_Click() DoCmd.GoToPage 2 End Sub 如何使鼠标停留在组合框上时，使组合框自动打开 如何使鼠标停留在组合框上时，使组合框自动打开 Private Sub 文本框_GotFocus() Me![文本框].Dropdown End Sub 如何让窗体总在最前面？ 如何让窗体总在最前面？ 来源不祥. ' API函数声明 Declare Function SetWindowPos Lib "user32" ( ByVal hwnd As Long, ByVal hWndInsertAfter As Long, 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