access-VBA编程第九章 VBA使用技巧4-小周专栏

第九章 VBA使用技巧4

怎样使用一个查询获得数据库对象的名称(查询/窗体/表/报表/模块/宏)?
查询:
Select MSysObjects.Name FROM MsysObjects Where (Left$([Name],1)<>"~") AND (MSysObjects.Type)=5 orDER BY MSysObjects.Name;
窗体:
Select MSysObjects.Name FROM MsysObjects Where (Left$([Name],1)<>"~") AND (MSysObjects.Type)=-32768 orDER BY MSysObjects.Name;
表:
Select MSysObjects.Name FROM MsysObjects Where (Left$([Name],1)<>"~") AND (Left$([Name],4) <> "Msys") AND (MSysObjects.Type)=1 orDER BY MSysObjects.Name;
报表:
Select MSysObjects.Name FROM MsysObjects Where (Left$([Name],1)<>"~") AND (MSysObjects.Type)= -32764 orDER BY MSysObjects.Name;
模块:
Select MSysObjects.Name FROM MsysObjects Where (Left$([Name],1)<>"~") AND (MSysObjects.Type)= -32761 orDER BY MSysObjects.Name;
宏:
Select MSysObjects.Name FROM MsysObjects Where (Left$([Name],1)<>"~") AND (MSysObjects.Type)= -32766 orDER BY MSysObjects.Name;
文件被创建或最后修改后的日期和时间FileDateTime 函数
返回一个 Variant (Date)，此为一个文件被创建或最后修改后的日期和时间。
语法
FileDateTime(pathname)
必要的 pathname 参数是用来指定一个文件名的字符串表达式。pathname 可以包含目录或文件夹、以及驱动器。
●适用于VB、VBA。
●用法：传回值 = FileDateTime("c:\windows\文件名.com")
让ACCESS程序发出声音的函数
Declare Function apisndPlaySound Lib "winmm" Alias "sndPlaySoundA" _
(ByVal filename As String, ByVal snd_async As Long) As Long
Function PlaySound(sWavFile As String)
' Purpose: Plays a sound.
' Argument: the full path and file name.
If apisndPlaySound(sWavFile, 1) = 0 Then
MsgBox "The Sound Did Not Play!"
End If
End Function
调用方法：PlaySound "文件名.WAV"
检测表中有无记录
tblAAAA,其中有一字段MMM
if isnull(dlookup("[MMM]","tblAAAA")) then
msgbox "此表无记录"
end if
使用表达式使一个文本框自动分为几段,并按文本格式首行左空2字!
加上chr()码，chr(32)是空格，10 和 13 分别为换行和回车字符。
身份证号输入的检查（焦点移到下一控件时）
Private Sub 下一控件名称_GotFocus()
If Len(Me.文本框) <> 15 And Len(Me.文本框) <> 18 Then
MsgBox "1111"
Me.文本框.SetFocus
End If
End Sub
如何使鼠标停留在组合框上时，使组合框自动打开
Private Sub 文本框_GotFocus()
Me![文本框].Dropdown
End Sub
组合框里面有20行数据，现在需要双击组合框，组合框内数据会依次显示
Private Sub Combo0_DblClick(Cancel As Integer)
If Combo0.ListCount < 1 Then Exit Sub
Dim I As Long
I = Combo0.ListCount
If Combo0.ListIndex < I - 1 Then
Combo0.ListIndex = Combo0.ListIndex + 1
Else
Combo0.ListIndex = 0
End If
End Sub
在VB中改变控件的类型
Private Sub cmdPerformMorph_Click()
DoCmd.Echo False, "Morphing controls, please wait..."
DoCmd.SelectObject acForm, "ControlMorphExampleForm2"
DoCmd.DoMenuItem acFormBar, 2, 0
If Forms!ControlMorphExampleForm2!cboEmployeeToQuery.ControlType = acListBox Then
Forms!ControlMorphExampleForm2!cboEmployeeToQuery.ControlType = acComboBox
Else
Forms!ControlMorphExampleForm2!cboEmployeeToQuery.ControlType = acListBox
End If
If Forms!ControlMorphExampleForm2!optMorphing.ControlType = acOptionButton Then
Forms!ControlMorphExampleForm2!optMorphing.ControlType = acCheckBox
Else
Forms!ControlMorphExampleForm2!optMorphing.ControlType = acOptionButton
End If
DoCmd.DoMenuItem acFormBar, 2, 1
DoCmd.SelectObject acForm, "ControlMorphExampleForm1"
DoCmd.Echo True
End Sub
数字货币转换为大写格式
以下为数字货币转换为大写格式程序, 首先建一个模块, 将以下程序复制进去并保存. (注: 最高位数为千万位)
调用方式为:
dollars = convertNum(inputValue)
^ ^
须显示填写小
大写的写的控
控件件名
-------------------------------------------
Function GetChoice1(ByVal ind As Integer)
GetChoice1 = Choose(ind + 1, "零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")
End Function
Function GetChoice2(ByVal ind As Integer) '注意"byval",按值传递
Dim tempInt As Integer
ind = ind - 1
tempInt = ind \ 4 '取商
ind = ind Mod 4 '取余
GetChoice2 = IIf(ind > 0, Choose(ind, "拾", "佰", "仟", "万"), Choose(IIf(tempInt > 2, 1, tempInt), "万", "亿"))
End Function
'--------------------------------------------
'主函数convertNum
Function ConvertNum(Baval Num As Variant) As String
Dim i As Integer, j As Integer
Dim tempInt As Integer
Dim tempStr, ResultStr As String
tempStr = CStr(Num) '转换成字符型
j = Len(tempStr) '取得长度
For i = 1 To j '对每个数字进行大写转换
tempInt = CInt(Mid(tempStr, j - i + 1, 1)) '
ResultStr = GetChoice1(tempInt) & GetChoice2(i) & ResultStr
Next i
ConvertNum = ResultStr
以下为数字货币转换为大写格式程序, 首先建一个模块, 将以下程序复制进去并保存. (注: 最高位数为千万位)
调用方式为:
dollars = chMoney(Val(inputValue))
^ ^
须显示填写小
大写的写的控
控件件名
' 名称： CCh
' 得到一位数字 N1 的汉字大写
' 0 返回 ""
Public Function CCh(N1) As String
Select Case N1
Case 0
CCh = "零"
Case 1
CCh = "壹"
Case 2
CCh = "贰"
Case 3
CCh = "叁"
Case 4
CCh = "肆"
77
ACCESS 与 VBA
Case 5
CCh = "伍"
Case 6
CCh = "陆"
Case 7
CCh = "柒"
Case 8
CCh = "捌"
Case 9
CCh = "玖"
End Select
End Function
'名称： ChMoney
' 得到数字 N1 的汉字大写。最大为千万位。 O 返回
Public Function chMoney(N1) As String
Dim tMoney As String
Dim lMoney As String
Dim tn '小数位置
Dim s1 As String '临时STRING 小数部分
Dim s2 As String '1000 以内
Dim s3 As String '10000
Dim st1, t1
If N1 = 0 Then
chMoney = " "
Exit Function
End If
If N1 < 0 Then
chMoney = "负" + chMoney(Abs(N1))
Exit Function
End If
tMoney = Trim(Str(N1))
tn = InStr(tMoney, ".") '小数位置
s1 = ""
If tn <> 0 Then
st1 = Right(tMoney, Len(tMoney) - tn)
If st1 <> "" Then
t1 = Left(st1, 1)
st1 = Right(st1, Len(st1) - 1)
If t1 <> "0" Then
s1 = s1 + CCh(Val(t1)) + "角"
End If
If st1 <> "" Then
t1 = Left(st1, 1)
s1 = s1 + CCh(Val(t1)) + "分"
End If
End If
st1 = Left(tMoney, tn - 1)
Else
st1 = tMoney
End If
s2 = ""
If st1 <> "" Then
t1 = Right(st1, 1)
st1 = Left(st1, Len(st1) - 1)
s2 = CCh(Val(t1)) + s2
End If
If st1 <> "" Then
t1 = Right(st1, 1)
st1 = Left(st1, Len(st1) - 1)
If t1 <> "0" Then
s2 = CCh(Val(t1)) + "拾" + s2
Else
If Left(s2, 1) <> "零" Then s2 = "零" + s2
End If
End If
If st1 <> "" Then
t1 = Right(st1, 1)
st1 = Left(st1, Len(st1) - 1)
If t1 <> "0" Then
s2 = CCh(Val(t1)) + "佰" + s2
Else
If Left(s2, 1) <> "零" Then s2 = "零" + s2
End If
End If
If st1 <> "" Then
t1 = Right(st1, 1)
st1 = Left(st1, Len(st1) - 1)
If t1 <> "0" Then
s2 = CCh(Val(t1)) + "仟" + s2
Else
If Left(s2, 1) <> "零" Then s2 = "零" + s2
End If
End If
s3 = ""
If st1 <> "" Then
t1 = Right(st1, 1)
st1 = Left(st1, Len(st1) - 1)
s3 = CCh(Val(t1)) + s3
End If
If st1 <> "" Then
t1 = Right(st1, 1)
st1 = Left(st1, Len(st1) - 1)
If t1 <> "0" Then
s3 = CCh(Val(t1)) + "拾" + s3
Else
If Left(s3, 1) <> "零" Then s3 = "零" + s3
End If
End If
If st1 <> "" Then
t1 = Right(st1, 1)
st1 = Left(st1, Len(st1) - 1)
If t1 <> "0" Then
s3 = CCh(Val(t1)) + "佰" + s3
Else
If Left(s3, 1) <> "零" Then s3 = "零" + s3
End If
End If
If st1 <> "" Then
t1 = Right(st1, 1)
st1 = Left(st1, Len(st1) - 1)
If t1 <> "0" Then
s3 = CCh(Val(t1)) + "仟" + s3
End If
End If
If Right(s2, 1) = "零" Then s2 = Left(s2, Len(s2) - 1)
If Len(s3) > 0 Then
If Right(s3, 1) = "零" Then s3 = Left(s3, Len(s3) - 1)
s3 = s3 & "万"
End If
chMoney = IIf(s3 & s2 = "", s1, s3 & s2 & "元" & s1)
End Function
如何加入换行符
C="A" + vbNewLine + "B"
[联系电话] = "1111" + Chr(13) + Chr(10) + "2222"
给一绑定文本框赋值，可以成功的看到换行效果：
1111
2222
在多页窗体中用按钮翻页
上一页
Private Sub 上一页_Click()
DoCmd.GoToPage 1
End Sub
下一页
Private Sub 下一页_Click()
DoCmd.GoToPage 2
End Sub
关闭指定窗体并按参数打开报表或窗体
Private Sub 打印各班名册_Click()
On Error GoTo 打印各班名册_Click_Err
DoCmd.Close acForm, "学籍管理库"
''指定报表或窗体名称，并指定基础表的字段的参数
DoCmd.OpenReport "同江市第三小学在校生名册", acPreview, "", "[在籍学生基本情况表]![年班]=[请输入年班（如：一年二班）]"
打印各班名册_Click_Exit:
Exit Sub
打印各班名册_Click_Err:
MsgBox Error$
Resume 打印各班名册_Click_Exit
End Sub
在窗体中按基础表的参数筛选
Private Sub 按班筛选_Click()
On Error GoTo 按班筛选_Click_Err
''在窗体中按基础表的参数筛选
DoCmd.ApplyFilter "", "[在籍学生基本情况表]![年班]=[请输入年级和班级（如：一年二班）]"
按班筛选_Click_Exit:
Exit Sub
按班筛选_Click_Err:
MsgBox Error$
Resume 按班筛选_Click_Exit
End Sub
取消所有筛选
Private Sub 取消所有筛选_Click()
DoCmd.ShowAllRecords
End Sub
使用 For...Next 语句
可以使用 For...Next 语句去重复一个语句块，而它的次数的数字是指定的。For 循环使用一个计数变量，当重复每个循环时它的值会增加或减少。
下面的过程会让计算机发出哔声 50 次。For 语句会指定计数变量 x 的开始与结束值。Next 语句会将计数变量的值加 1。
Sub Beeps()
For x = 1 To 50
Beep
Next x
End Sub
使用 Step 关键字，可以由所指定的值增加或减少计数变量。在下面的示例中，计数变量 j 会在每次循环重复时加上 2。当循环完成时，total 的值为 2、4、6、8 和 10 的总合。
Sub TwosTotal()
For j = 2 To 10 Step 2
total = total + j
Next j
MsgBox "The total is " & total
End Sub
为了减少计数变量的值，可以使用负的 Step 值。为了减少计数变量的值，必须指定一个小于开始值的结束值。在下面的示例中，计数变量 myNum 会在每次循环重复时减去 2。当循环完成时，total 的值为 16、14、12、10、8、6、4 和 2 的总合。
Sub NewTotal()
For myNum = 16 To 2 Step -2
total = total + myNum
Next myNum
MsgBox "The total is " & total
End Sub
注意在 Next 语句后面不必包含计数变量的名称。上述的示例中，因为要具有可读性才加上计数变量的名称。
可以在计数变量到达它的结束值之前，使用 Exit For 语句来退出 For...Next 语句。例如，当错误发生时，可以使用在 If...Then...Else 语句或是 Select Case 语句的 True 语句块中的 Exit For 语句，它是专门用来检查此错误的。如果没有错误发生，则 If...Then...Else 语句的值为 False，循环会象预期那样的运行。