资源描述
ACCESSVBA编程.控件：常量 控件 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 IntegerDim intReportControls As IntegerintFormControls = Forms!Employees.CountintReportControls = Reports!FreightCharges.Count设置控件可见性Dim i, ii As IntegerFor ii = 3 To 10 Me.Controls.Item(ii).Visible = TrueNextFor i = 11 To 22 Me.Controls.Item(i).Visible = FalseNext按特殊名在VBA中设置控件的可见性：For i = 27 To 47 If Me.Controls.Item(i).Name Like A* Then Me.Controls.Item(i).Visible = False End If Next指定一个控件能否接受焦点Enabled属性： me.控件.Enabled = true能 =false不能指定一个控件能否被编辑：locked如：me.控件.Locked = trueme.控件.Locked = false设置控件标题显示的文字Me.控件.Caption = 显示窗体设置标签颜色：Me.LabelColor =200获得焦点及失去焦点时字段变更颜色。如果你的控件是文本框，名称为“txt字段”，写如下代码：Private Sub txt字段_GotFocus() Me.txt字段.BackColor = 12632256End Sub当中“12632256”是灰色，你可以自己选择希望的颜色，如果想在失去焦点时改为原来的颜色，写如下代码：Private Sub txt字段_LostFocus() Me.txt字段.BackColor = 16777215End Sub使标签闪烁以引人注意设置窗体的TimerInterval 值为1000 (1秒).forms OnTimer 加入代码:Sub Form_Timer()YourTextLabel.Visible = Not YourTextLabel.VisibleEnd_Sub设置标签字体颜色：Me.Label1.ForeColor =设置文本框颜色：Me.TextColor = 300设置文本框字体颜色：Me.TextFontColor = 500标签等左边距离：Me.Label2.Left = 2200定位控件Me.控件.Top = 8290Me. 控件.Left = 100设置控件宽度/高度Me.考生答案.Width = 10000Me.考生答案.Height = 1000标签等字体粗细：Me.Label2.FontWeight = 20000控件边框颜色：Me.Label2.BorderColor = 0控件边框线条BorderStyle 属性使用以下设置：透明 0 （仅对于标签、图表和子报表而言是默认值）透明的 实线 1 （默认值）实线 虚线 2 虚线 短虚线 3 短虚线 点线 4 点线 稀疏点线 5 点距较宽的点线 点划线 6 虚线与点线组合的点划线 点点划线 7 虚线-点线-点线组合的点点划线 双实线 8 双实线 指定控件的边框宽度使用 BorderWidth 属性可以指定控件的边框宽度取值：0或16指定控件是否透明使BackStyle 属性可以指定控件是否透明。True 、False 解除子窗体锁定Me.进_子窗体.Locked = False 解除子窗体锁定将窗体上所有控件的输入法关掉!来源:不祥 Private Sub Form_Open(Cancel As Integer)Dim ctl As Access.ControlFor Each ctl In Me.ControlsDebug.Print ctl.Name & ctl.ControlTypeIf ctl.ControlType = acTextBox Thenctl.IMEMode = 2End IfNextEnd 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)如果引用了组合框或列表框中的列，但用户未做选择，则 Column 属性设置将为 Null。可以使用 IsNull 函数来确定是否进行了选择，示例如下：If IsNull(Forms!Customers!Country) Then MsgBox No selection.End If显示获得焦点的控件的 Name： ctl As Control Set ctl = Screen.ActiveControl MsgBox ctl.Name窗体：如何让窗体的标题条闪烁以引起用户注意？在窗体中放一个Timer控件Timer1,设置其Inteval=200*API函数声明PrivateDeclareFunctionFlashWindowLibuser32(ByValhwndAsLong,ByValbInvertAsLong)AsLong注释：在窗体中写下如下代码:PrivateSubTimer1_Timer()FlashWindowMe.hwnd,TrueEndSub窗体上如何使用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可调边框4对话框边框设置窗体、页眉、页脚颜色：Me.Section(0).BackColor = 200Me.Section(1).BackColor = 200Me.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(列名).ColumnWidth = 400允许分隔线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 属性不决定是否可以添加记录，只决定是否显示已有的记录。Boolean 型，可读/写。True 、False允许/不允许筛选me.AllowFilters=True/FalseFilter=筛选内容筛选应用与/否筛选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 FalseDim x, y As IntegerDoCmd.Maximizex = Me.WindowWidthy = Me.WindowHeightDoCmd.RestoreDoCmd.Echo TrueMove (x - Me.WindowWidth) / 2, (y - Me.WindowHeight) / 2End Sub隐藏窗体学生名册数据表视图中的性别字段Table!学生名册!性别.ColumnHidden = -1显示获得焦点窗体的 Name 属性设置：使用 ActiveForm 属性（和 Screen 对象一起）可以标识或引用获得焦点的窗体。Dim dqhdct As FormSet dqhdct = Screen.ActiveFormMsgBox 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(frmMain).IsLoaded = True ThenForms!frmMain.Form.Visible = FalseEnd If窗体中组合框不在列表中示例不在列表中事件代码：Private Sub 名称_NotInList(NewData As String, Response As Integer) Response = acDataErrContinue If MsgBox(您输入的名称不在列表中，在列表中添加新记录吗？, 68, 银河酒业) = 6 Then Me!名称 = Null DoCmd.GoToControl 单价 DoCmd.OpenForm 酒名列表, , , , acAdd, acNormal Else Me!名称 = Null Me!名称.Dropdown End IfEnd Sub获得焦点事件代码：Private Sub 名称_GotFocus()Me!名称.RequeryEnd Sub如何让窗体总在最前面？*API函数声明DeclareFunctionSetWindowPosLibuser32(ByValhwndAsLong,ByValhWndInsertAfterAsLong,ByValxAsLong,ByValyAsLong,ByValcxAsLong,ByValcyAsLong,ByValwFlagsAsLong)AsLong注释：常量声明PrivateConstSWP_NOSIZE=&H1PrivateConstSWP_NOMOVE=&H2PrivateConstHWND_TOPMOST=-1PrivateConstHWND_NOTOPMOST=-2注释：在某个form里写：SetWindowPosme.hWnd,WND_TOPMOST,0,0,0,0,SWP_NOMOVE注释：或下面SetWindowPosme.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折线图折线图xlLine数据点折线图xlLineMarkers堆积折线图xlLineStacked堆积数据点折线图xlLineMarkersStacked堆积百分比折线图xlLineStacked100百分比堆积数据点折线图xlLIneMarkersStacked100三维折线图xl3DLine饼图饼图xlPie分离型饼图xlPieExploded三维饼图xl3Dpie三维分离型饼图xl3DPieExploded复合饼图xlPieOfPie复合柱饼图xlBarOfPieXY(散点图)散点图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百分比堆积条形圆锥图xlConeBarStacked100三维柱形圆锥图xlConeCol棱锥图簇状柱形棱锥图xlPyramidColClustered簇状条形棱锥图xlPyramidBarClustered堆积柱形棱锥图xlPyramidColStacked堆积条形棱锥图xlPyramidBarStacked百分比堆积柱形棱锥图xlPyramidColStacked100百分比堆积条形棱锥图xlPyramidBarStacked100三维堆积柱形棱锥图Color属性移动无边框窗体例子模块：Declare Function SendMessage Lib user32 Alias SendMessageA (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongDeclare Function ReleaseCapture Lib user32 () As LongPublic Const WM_NCLBUTTONDOWN = &HA1Public Const HTCAPTION = 2应用：Private Sub Form_Close()DoCmd.RunCommand acCmdAppMaximizeEnd SubPrivate Sub Form_Load()DoCmd.RunCommand acCmdAppMinimizeEnd SubPrivate 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 IfEnd SubPrivate Sub 命令20_Click()DoCmd.CloseEnd Sub如何移动没有标题栏的窗口？我们一般是用鼠标按住窗口的标题栏，然后移动窗口，当窗口没有标题栏时，我们可以用下面的方法来移动窗口：*API函数声明：DeclareFunctionReleaseCaptureLibuser32()AsLongDeclareFunctionSendMessageLibuser32AliasSendMessageA(ByValhwndAsLong,ByValwMsgAsLong,ByValwParamAsLong,lParamAsAny)AsLongPublicConstHTCAPTION=2PublicConstWM_NCLBUTTONDOWN=&HA1在Form_MouseDown事件中：PrivateSubForm_MouseDown(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)ReleaseCaptureSendMessagehwnd,WM_NCLBUTTONDOWN,HTCAPTION,0&EndSub日期、时间函数如何将文本型：2003.08.04 转换为日期型：2003-08-04cdate(replace(2003.08.04,.,-)显示当前日期在该年中所处的星期号=Format(Now(), ww)ww 为 1 到 53。显示日期字段值的四位年份值。=DatePart（yyyy, 订购日期）显示日期字段值前 10 天的日期值。=DateAdd（y, -10, 应付日期）显示日期字段值前一个月的日期值。=DateAdd(m,-1,Date()显示日期1和日期2之间相差的天数。=DateDiff（d, 订购日期, 发货日期）从今天算起到三个月后的日期之间的记录。Betweeb date() and adddate(3,date()根据出生日期计算年龄（周岁）=IIf(Month(Date()-Month(出生年月日)-1,Year(Date()-Year(出生年月日),Year(Date()-Year(出生年月日)-1)自定义日期/时间格式 (Format 函数)(:) 时间分隔符。在一些区域，可能用其他符号来当时间分隔符。格式化时间值时，时间分隔符可以分隔时、分、秒。时间分隔符的真正字符在格式输出时取决于系统的设置。(/) 日期分隔符。在一些区域，可能用其他符号来当日期分隔符。格式化日期数值时，日期分隔符可以分隔年、月、日。日期分隔符的真正字符在格式输出时取决于系统设置。C 以 ddddd 来显示日期并且以 ttttt 来显示时间。如果想显示的数值无小数部分，则只显示日期部分，如果想显示的数值无整数部分，则只显示时间部分。D以没有前导零的数字来显示日 (131)。Dd以有前导零的数字来显示日 (0131)。ddd以简写来表示日 (SunSat)。dddd以全称来表示日 (SundaySaturday)。ddddd以完整日期表示法显示（包括年、月、日），日期的显示要依系统的短日期格式设置而定。缺省的短日期格式为 m/d/yy。dddddd以完整日期表示法显示日期系列数（包括年、月、日），日期的显示要依系统识别的长日期格式而定。缺省的长日期格式为 mmmm dd, yyyy。aaaa与dddd 一样，它只是该字符串的本地化版本。W将一周中的日期以数值表示（1 表星期日 7表星期六）。ww将一年中的星期以数值表示 (154)。M以没有前导零的数字来显示月 (112)。如果 m 是直接跟在 h 或 hh 之后，那么显示的将是分而不是月。mm以有前导零的数字来显示月 (0112)。如果m是直接跟在h或hh之后，那么显示的将是分而不是月。mmm以简写来表示月 (JanDec)。mmmm以全称来表示月 (JanuaryDecember)。oooo与mmmm一样，它只是该字符串的本地化版本。Q将一年中的季以数值表示 (14)。Y将一年中的日以数值表示 (1366)。Yy以两位数来表示年 (0099)。yyyy以四位数来表示年 (0099)。H以没有前导零的数字来显示小时 (023)。Hh以有前导零的数字来显示小时 (0023)。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(q,Date()把日期大写Function Date2Chinese(iDate) Dim num(10) Dim iYear 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 + _ 十 + num(iMonth Mod 10) + 月 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 + _ 十 + num(iDay Mod 10) + 日 End If Else Date2Chinese = Date2Chinese + _ num(iDay Mod 10) + 日 End IfEnd Function算出每个月的天数一法： Dim a, b, ca = Year(Now()b = Month(Now()c = Format(a & / & b + 1 & /1), #) - Format(a & / & b & /1), #)二法： DateDiff(d, Format(Date, yyyy-mm-01), Format(DateAdd(m, -1, Date), yyyy-mm-01)DateDiff可以算出两个日期之间相差几天！三法：Day(DateAdd(d, -1, Format(Date, yyyy-mm-01)day函数可以知道某个日期是这个月的第几天，我们把这个月的最后一天拿出来DAY一下！应该还有更好的方法！比如说可以定义一个数组，把每个月的日子放进去，或者说写一个函数算每一个月的天数只要考虑一下闺年的问题就可以了！如何得到某年每个月的第一天是星期几Private Sub Command1_Click()Dim i As Integer, A As Integer, B As Integer, C As StringA = InputBox(请输入年份, 某年每个月的第一天是星期几)Form1.ClsFor i = 1 To 12C = A & - & i & -1B = Weekday(C)Select Case BCase vbSundayPrint A & 年 & i & 月1日是 星期日Case vbMondayPrint A & 年 & i & 月1日是 星期一Case vbTuesdayPrint A & 年 & i & 月1日是 星期二Case vbWednesdayPrint A & 年 & i & 月1日是 星期三Case vbThursdayPrint A & 年 & i & 月1日是 星期四Case vbFridayPrint A & 年 & i & 月1日是 星期五Case vbSaturdayPrint A & 年 & i & 月1日是 星期六End SelectNext i End Sub计算天数及月初月末日期Function 本月天数(日期 As Date) As Byte 本月天数 = DateSerial(Year(日期), Month(日期) + 1, Day(日期) - 日期 End Function 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(m,1,DateSerial(Year(Date(),Month(Date(),1)-1) AS 本月最后一日是周几,下月最后一日是周几SELECTWeekday(DateAdd(m,2,DateSerial(Year(Date(),Month(Date(),1)-1) AS 下月最后一日是周几,本月最后一个周5到月底的天数SELECT(Weekday(DateAdd(m,1,DateSerial(Year(Date(),Month(Date(),1)-1)+1) Mod 7 AS 本月最后一个周5到月底的天数;下月最后一个周5到月底的天数SELECT(Weekday(DateAdd(m,2,DateSerial(Year(Date(),Month(Date(),1)-1)+1) Mod 7 AS 下月最后一个周5到月底的天数;本月最后一个周5的日期SELECTDateAdd(m,1,DateSerial(Year(Date(),Month(Date(),1)-1-(Weekday(DateAdd(m,1,DateSerial(Year(Date(),Month(Date(),1)-1)+1) Mod 7 AS 本月最后一个周5的日期;下月最后一个周5的日期SELECTDateAdd(m,2,DateSerial(Year(Date(),Month(Date(),1)-1-(Weekday(DateAdd(m,2,DateSerial(Year(Date(),Month(Date(),1)-1)+1) Mod 7 AS 下月最后一个周5的日期;数据输入、查询、计算、连接：通过英特网的ACCESS联接在ACCESS中使用ADO： Private Sub ABC_Click()Dim cn As New ADODB.ConnectionDim rs As New ADODB.Recordsetcn.OPEN DSN=alwin;UID=;PWD=;rs.OPEN Select * from tbTABLE, cn, adOpenDynamic, adLockReadOnlyrs.ABC App.Path & testdata.dat, adPersistADTGrs.Closecn.CloseMsgBox (OPERATION OK)End SubPrivate Sub OPEN_Click()Dim strConnect As StringstrConnect = Provider=MSPersistDim rs As New ADODB.Recordsetrs.OPEN http:/远程服务器的IP/test/testdata.dat, strConnectDo While Not rs.EOFDebug.Print rs(USERID).valuers.MoveNextLoopEnd 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) + 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 IntegerLength = 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 IfEnd If两行代码打开另一数据库PrivateSub命令4_Click()OnErrorGoToErr_命令4_ClickDimstrDbAsStringstrDb=C:db1.mdb SendKeysF11%FO&strDb&enterExit_命令4_Click:ExitSubErr_命令4_Click:MsgBoxErr.DescriptionResumeExit_命令4_ClickEndSub实现打开外部数据库中的报表。Private Declare Function apiSetForegroundWindow Lib user32 _ Alias SetForegroundWindow _ (ByVal hwnd As Long) _ As LongPrivate Declare Function apiShowWindow Lib user32 _ Alias ShowWindow _ (ByVal hwnd As Long, _ ByVal nCmdShow As Long) _ As LongPrivate Const SW_MAXIMIZE = 3Private Const SW_NORMAL = 1Function 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 = N
展开阅读全文