accessvba编程 第九章 vba使用技巧3.docx
《accessvba编程 第九章 vba使用技巧3.docx》由会员分享，可在线阅读，更多相关《accessvba编程 第九章 vba使用技巧3.docx（9页珍藏版）》请在冰豆网上搜索。
accessvba编程第九章vba使用技巧3
ACCESS-VBA编程第九章VBA使用技巧3
第九章VBA使用技巧3
Treeview控件的使用方法
建立一个窗体，在窗体上放置如下控件：
Treeview控件：
名称Treeview1；
Imagelist控件：
名称Imagelist1，并在该控件中放置三张个性图片（32×32），建立索引1、2、3；（方法：
在Imagelist控件上单击鼠标右键选择属性）
Label控件：
名称分别为Lab（0）、Lab
（1），Caption分别为“父节点：
”、“子节点：
”；
Textbox控件：
名称分别为Txt（0）、Txt
（1），text都为“”；
commandbutton控件：
名称为系统默认，Caption分别为“添加”、“展开”、“收起”、“排序”、“删除”、“退出”；
将下列代码加入到代码框：
OptionExplicit
DimIAsInteger
DimJAsInteger
DimnodxAsNode
DimCunZaiAsBoolean'定义变量
PrivateSubCommand1_Click（）
IfTxt（0）.Text<>""AndTxt
（1）.Text<>""Then'不允许建立零字节的父节点和子节点
CunZai=False
J=TreeView1.Nodes.Count
ForI=1ToTreeView1.Nodes.Count'检查新输入的父节点名称是否存在
IfTreeView1.SelectedItem.Children>0Then
IfTxt（0）.Text=TreeView1.Nodes（I）.TextThenCunZai=True
EndIf
NextI
IfCunZai=TrueThen'若存在,则在父节点下建立子节点
Setnodx=TreeView1.Nodes.Add（Txt（0）.Text,tvwChild,"child"&J,
Txt
（1）.Text,3）
Else,若不存在,则建立父节点和子节点
Setnodx=TreeView1.Nodes.Add（,,Txt（0）.Text,Txt（0）.Text,1）
Setnodx=TreeView1.Nodes.Add（Txt（0）.Text,tvwChild,"child"&J,_
Txt
（1）.Text,3）
EndIf
TreeView1.Refresh
ElseIfTxt（0）.Text=""ThenMsgBox"请输入父节点名称!
",vbInformation,"警告！
"
'系统提示
ElseIfTxt
（1）.Text=""ThenMsgBox"请输入子节点名称!
",vbInformation,"警告！
"
EndIf
EndSub
PrivateSubCommand2_Click（）
ForI=1ToTreeView1.Nodes.Count
TreeView1.Nodes（I）.Expanded=True'展开所有节点
NextI
EndSub
PrivateSubCommand3_Click（）
ForI=1ToTreeView1.Nodes.Count
TreeView1.Nodes（I）.Expanded=False'收起所有节点
NextI
EndSub
PrivateSubCommand4_Click（）
TreeView1.Sorted=True'排列顺序
EndSub
PrivateSubCommand5_Click（）
IfTreeView1.SelectedItem.Index<>1Then
TreeView1.Nodes.RemoveTreeView1.SelectedItem.Index'删除选定的节点
EndIf
EndSub
PrivateSubCommand6_Click（）
End'退出程序
EndSub
PrivateSubForm_Load（）
TreeView1.LineStyle=TvwTreeLines'在兄弟节点和父节点之间显示线
TreeView1.ImageList=ImageList1'链接图像列
TreeView1.Style=tvwTreelinesPlusMinusPictureText
'树状外观包含全部元素
Setnodx=TreeView1.Nodes.Add（,,"蒲子明","蒲子明",1）
'建立名称为"蒲子明"的父节点,选择索引为1的图像
Setnodx=TreeView1.Nodes.Add（"蒲子明",tvwChild,"child01","收件箱",3）
'在"蒲子明"父节点下建立"收件箱"子节点,选择索引为3的图像
Setnodx=TreeView1.Nodes.Add（"蒲子明",tvwChild,"child02","发件箱",3）
'在"蒲子明"父节点下建立"发件箱"子节点,选择索引为3的图像
CunZai=False
EndSub
PrivateSubTreeView1_Expand（ByValNodeAsMSComctlLib.Node）
Node.ExpandedImage=2'节点被展开时,选择索引为2的图像
EndSub
PrivateSubTreeView1_NodeClick（ByValNodeAsMSComctlLib.Node）
IfTreeView1.SelectedItem.Children=0Then'检查是否有子节点,0为无
ForI=1ToTreeView1.Nodes.Count
IfTreeView1.Nodes（I）.SelectedThen
MsgBox"您选择的是：
“"&TreeView1.Nodes（I）.FullPath&"”子节点！
"
'系统提示
EndIf
NextI
EndIf
EndSub
TreeView控件示例：
PrivateSubForm_Load（）
DimcnnAsNewADODB.Connection,rstAsNewADODB.Recordset
DimnodsAsNodes
DimmnodeAsNode
DimnodefAsString
DimhhAsString
Setcnn=CurrentProject.Connection
rst.Open"select*frommenuorderby菜单号",cnn,adOpenStatic
rst.MoveFirst
DoWhileNotrst.EOF
nodef=rst!
菜单号
IfIsNull（rst!
上级菜单）Then
Setmnode=TreeView0.Nodes.Add（,,rst!
菜单号,rst!
菜单名,1,2）
Else
nodef=rst!
上级菜单
Setmnode=TreeView0.Nodes.Add（nodef,tvwChild,rst!
菜单号,rst!
菜单名,3,4）
EndIf
rst.MoveNext
Loop
Setrst=Nothing
WithTreeView0
.Nodes
（1）.Expanded=True
EndWith
EndSub
PrivateSubTreeView0_NodeClick（ByValNodeAsObject）
DimvarxAsVariant
varx=DLookup（"[记录]","menu","[菜单名]="&"'"&Node&"'"）
Me.记录=varx
EndSub
如果盘中不存在文件test.dll，则退出数据库
ifdir（"c:
\windows\test.dll"）=""then
docmd.quit
endif
使用Shell函数来完成一个用户指定的应用程序。
使用Shell函数来完成一个用户指定的应用程序。
在MacIntosh上，默认的驱动名为“HD”，路径名称的每部分由冒号而非反斜线分隔。
相似地，您可以指定Macintosh文件夹而非\Windows.
'将第二个参数值设成1，可让该程序以正常大小的窗口完成，并且拥有焦点。
DimRetVal
RetVal=Shell（"C:
\WINDOWS\CALC.EXE",1）'完成Calculator。
Shell（"C:
\WINDOWS\hh.exec:
\a.chm",vbNormalFocus）
hh.exe是打开chm的程序文件。
chm是帮助文件
对外部文件管理
Setfs=CreateObject（"Scripting.FileSystemObject"）'设置系统计算机的驱动器、文件夹和文件记录集
fs.CopyFile"c:
\12345.txt","c:
\abcde.txt"'拷贝文件
或：
filecopyc:
\a.mdb,d:
\b.mdb
fs.DeleteFile"c:
\12345.txt"'删除刚拷贝的文本文件
打开外部数据库
PrivateSubCommand5_Click（）
DimaobjectAsString
'定义对象变量
Setaobject=openobject（"e:
\学生规范考查.mdb",True,False）
'打开名为学生规范考查.mdb的库
EndSub
提示用户插入软盘
如果驱动器中没有软盘则会出现错误，
程序应提供没有软盘的信息：
SubInsertDisk（）
OnErrorResumeNext
IfIsError（MyFile=Dir（“a:
”,vbVolume））=TrueThen
MsgBox“驱动器中没有软盘，请插入软盘！
”
ExitSub
EndIf
EndSub
向表中加新字段
CurrentDb.Execute"AlterTable表名AddColumn新字段名Char（13）"
自定义函数IsYlwjcct（"窗体名"）（如果指定的窗体打开，返回True）
FunctionIsYlwjcct（ByValstrFormNameAsString）AsBoolean
ConstconObjStateClosed=0
ConstconDesignView=0
IfSysCmd（acSysCmdGetObjectState,acForm,strFormName）<>conObjStateClosedThen
IfForms（strFormName）.CurrentView<>conDesignViewThen
IsYlwjcct=True
EndIf
EndIf
EndFunction
删除当前数据库的表的字段
CurrentDb.Execute"AlterTable名表DropColumn字段名"
使主程序窗口的X失效
PrivateDeclareFunctionGetSystemMenuLib"User32"（ByValhwndAsLong,ByValbRevertAsLong）AsLong
PrivateDeclareFunctionDeleteMenuLib"User32"（ByValhMenuAsLong,ByValnPositionAsLong,ByValwFlagsAsLong）AsLong
PrivateSubFORM_Load（）
ConstMF_BYCOMMAND=&H0&
ConstSC_CLOSE=&HF060
DimhMenuAsLong
hMenu=GetSystemMenu（Application.hWndAccessApp,0）
CallDeleteMenu（hMenu,SC_CLOSE,MF_BYCOMMAND）
EndSub
打开模块
DoCmd.OpenModule"设置启用禁用shift",""
隐藏当前活动窗体
me.Form.Visible=True
隐藏主窗口
GlobalConstSW_HIDE=0
GlobalConstSW_SHOWNORMAL=1
GlobalConstSW_SHOWMINIMIZED=2
GlobalConstSW_SHOWMAXIMIZED=3
'使用举例
'最大化Access窗口
'?
fSetAccessWindow（SW_SHOWMAXIMIZED）
'最小化Access窗口
'?
fSetAccessWindow（SW_SHOWMINIMIZED）
'隐藏Access窗口
'?
fSetAccessWindow（SW_HIDE）
'正常显示Access窗口
'?
fSetAccessWindow（SW_SHOWNORMAL）
'
OptionCompareDatabase
PrivateDeclareFunctionapiShowWindowLib"user32"Alias"ShowWindow"（ByValhwndAsLong,ByValnCmdShowAsLong）AsLong
FunctionfSetAccessWindow（nCmdShowAsLong）
DimloXAsLong
DimloFormAsForm
OnErrorResumeNext
loX=apiShowWindow（hWndAccessApp,nCmdShow）
Err.Clear
fSetAccessWindow=（loX<>0）
EndFunction
PrivateSubForm_Load（）
DimyhsfmAsString
yhsfm=CurrentUser（）
Ifyhsfm<>"ylw"Then
DimX
X=fSetAccessWindow（0）
EndIf
Endsub
在一个窗体中执行另一窗体的子程序
来源：
爱赛思应用俱乐部huanghai
DoCmd.OpenForm"窗体2"
CallForms（"窗体2"）.aaa
禁用主窗口最大化和最小化按钮
'声明
PrivateDeclareFunctionGetSystemMenuLib"user32.dll"_
（ByValhwndAsLong,ByValbRevertAsLong）AsLong
PrivateDeclareFunctionRemoveMenuLib"user32.dll"_
（ByValhMenuAsLong,ByValuPositionAsLong,ByValuFlagsAsLong）AsLong
'使用
PrivateSubForm_Load（）
DimhSysMenuAsLong
DimretvalAsLong
hSysMenu=GetSystemMenu（hWndAccessApp,0）
retval=RemoveMenu（hSysMenu,&HF120,&H0）
hSysMenu=GetSystemMenu（Me.hwnd,0）
retval=RemoveMenu（hSysMenu,&HF120,&H0）
EndSub
让主窗口最大化和最小化按钮消失
'声明：
PrivateDeclareFunctionSetWindowLongLib"user32"_
Alias"SetWindowLongA"（ByValhwndAsLong,ByVal_
nIndexAsLong,ByValdwNewLongAsLong）AsLong
PrivateDeclareFunctionGetWindowLongLib"user32"_
Alias"GetWindowLongA"（ByValhwndAsLong,ByVal_
nIndexAsLong）AsLong
ConstWS_MINIMIZEBOX=&H20000
ConstWS_MAXIMIZEBOX=&H10000
ConstGWL_STYLE=（-16）
'使用：
PrivateSubForm_Load（）
DimlWndAsLong
lWnd=GetWindowLong（hWndAccessApp,GWL_STYLE）
lWnd=lWndAndNot（WS_MINIMIZEBOX）
lWnd=lWndAndNot（WS_MAXIMIZEBOX）
lWnd=SetWindowLong（hWndAccessApp,GWL_STYLE,lWnd）
EndSub
计时器触发
Me.Text4.Value=Now（）
隐藏当前激活的工具条：
DimdqgjtAsVariant
Setdqgjt=CommandBars.ActiveMenuBar
dqgjt.Enabled=False
显示和隐藏自定义的工具条
DoCmd.ShowToolbar"你的工具条名称",acToolbarYes
DoCmd.ShowToolbar"你的工具条名称",acToolbarNo
隐藏主程序窗口：
（详见示例库）
OptionCompareDatabase
OptionExplicit
PrivateConstSW_HIDE=0
PrivateConstSW_SHOWNORMAL=1
PrivateDeclareFunctionapiShowWindowLib"user32"_
Alias"ShowWindow"（ByValhWndAsLong,_
ByValnCmdShowAsLong）AsLong
PrivateSubCommand0_Click（）
IfMe.Command0.Caption="隐藏窗体"Then
Me.Command0.Caption="显示窗体"
CallapiShowWindow（hWndAccessApp,SW_HIDE）
DoCmd.Restore
Else
Me.Command0.Caption="隐藏窗体"
CallapiShowWindow（hWndAccessApp,SW_SHOWNORMAL）
DoCmd.CloseacForm,"frm_main"
DoCmd.ShowToolbar"菜单栏",acToolbarYes
DoCmd.Restore
EndIf
EndSub
主窗口最小化：
DoCmd.RunCommandacCmdAppMinimize
用代码打开窗体中选项卡控件的某页
Me.选项卡控件名.Pages（n）.SetFocus
其中n是要打开的页号（页号是从0开始的）
对不同视图中对象的标题进行设置
使用Caption属性可以对不同视图中对象的标题进行设置，为用户提供有用的信息：
字段标题用于指定通过从字段列表中拖动字段而创建的控件所附标签上的文本，并作为表或查询“数据表”视图中字段的列标题。
窗体标题用于指定在“窗体”视图中标题栏上显示的文本。
报表标题用于指定在“打印预览”中报表的标题。
按钮和标签标题用于指定在控件中显示的文本。
String型，可读写。
expression.Caption
expression必需。
返回“AppliesTo”列表中的一个对象的表达式。
升级会员 