access-VBA编程 第九章 VBA使用技巧3

时　间:2009-02-27 08:38:01
作　者:UMVsoft整理   ID：1445  城市：上海
摘　要:VBA
正　文:

第九章 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分别为“添加”、“展开”、“收起”、“排序”、“删除”、“退出”；
将下列代码加入到代码框：
Option Explicit
Dim I As Integer
Dim J As Integer
Dim nodx As Node
Dim CunZai As Boolean '定义变量
Private Sub Command1_Click()
If Txt(0).Text <> "" And Txt(1).Text <> "" Then '不允许建立零字节的父节点和子节点
CunZai = False
J = TreeView1.Nodes.Count
For I = 1 To TreeView1.Nodes.Count '检查新输入的父节点名称是否存在
If TreeView1.SelectedItem.Children > 0 Then
If Txt(0).Text = TreeView1.Nodes(I).Text Then CunZai = True
End If
Next I
If CunZai = True Then '若存在, 则在父节点下建立子节点
Set nodx = TreeView1.Nodes.Add(Txt(0).Text, tvwChild, "child" & J,
Txt(1).Text, 3)
Else ,若不存在,则建立父节点和子节点
Set nodx = TreeView1.Nodes.Add(, , Txt(0).Text, Txt(0).Text, 1)
Set nodx = TreeView1.Nodes.Add(Txt(0).Text, tvwChild, "child" & J,_
Txt(1).Text, 3)
End If
TreeView1.Refresh
ElseIf Txt(0).Text = "" Then MsgBox "请输入父节点名称!", vbInformation, "警告！"
'系统提示
ElseIf Txt(1).Text = "" Then MsgBox "请输入子节点名称!", vbInformation, "警告！"
End If
End Sub
Private Sub Command2_Click()
For I = 1 To TreeView1.Nodes.Count
TreeView1.Nodes(I).Expanded = True '展开所有节点
Next I
End Sub
Private Sub Command3_Click()
For I = 1 To TreeView1.Nodes.Count
TreeView1.Nodes(I).Expanded = False '收起所有节点
Next I
End Sub
Private Sub Command4_Click()
TreeView1.Sorted = True '排列顺序
End Sub
Private Sub Command5_Click()
If TreeView1.SelectedItem.Index <> 1 Then
TreeView1.Nodes.Remove TreeView1.SelectedItem.Index '删除选定的节点
End If
End Sub
Private Sub Command6_Click()
End '退出程序
End Sub
Private Sub Form_Load()
TreeView1.LineStyle =TvwTreeLines '在兄弟节点和父节点之间显示线
TreeView1.ImageList = ImageList1 '链接图像列
TreeView1.Style = tvwTreelinesPlusMinusPictureText
'树状外观包含全部元素
Set nodx = TreeView1.Nodes.Add(, , "蒲子明", "蒲子明", 1)
'建立名称为"蒲子明"的父节点,选择索引为1的图像
Set nodx = TreeView1.Nodes.Add("蒲子明", tvwChild, "child01", "收件箱", 3)
'在"蒲子明"父节点下建立"收件箱"子节点,选择索引为3的图像
Set nodx = TreeView1.Nodes.Add("蒲子明", tvwChild, "child02", "发件箱", 3)
'在"蒲子明"父节点下建立"发件箱"子节点,选择索引为3的图像
CunZai = False
End Sub
Private Sub TreeView1_Expand(ByVal Node As MSComctlLib.Node)
Node.ExpandedImage = 2 '节点被展开时,选择索引为2的图像
End Sub
Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
If TreeView1.SelectedItem.Children = 0 Then '检查是否有子节点,0为无
For I = 1 To TreeView1.Nodes.Count
If TreeView1.Nodes(I).Selected Then
MsgBox "您选择的是：“" & TreeView1.Nodes(I).FullPath & "”子节点！"
'系统提示
End If
Next I
End If
End Sub

TreeView控件示例：
Private Sub Form_Load()
Dim cnn As New ADODB.Connection, rst As New ADODB.Recordset
Dim nods As Nodes
Dim mnode As Node
Dim nodef As String
Dim hh As String
Set cnn = CurrentProject.Connection
rst.Open "select * from menu order by 菜单号", cnn, adOpenStatic
rst.MoveFirst
Do While Not rst.EOF
nodef = rst!菜单号
If IsNull(rst!上级菜单) Then
Set mnode = TreeView0.Nodes.Add(, , rst!菜单号, rst!菜单名, 1, 2)
Else
nodef = rst!上级菜单
Set mnode = TreeView0.Nodes.Add(nodef, tvwChild, rst!菜单号, rst!菜单名, 3, 4)
End If
rst.MoveNext
Loop
Set rst = Nothing
With TreeView0
.Nodes(1).Expanded = True
End With
End Sub
Private Sub TreeView0_NodeClick(ByVal Node As Object)
Dim varx As Variant
varx = DLookup("[记录]", "menu", "[菜单名]=" & "'" & Node & "'")
Me.记录 = varx
End Sub
如果盘中不存在文件test.dll，则退出数据库
if dir("c:\windows\test.dll")="" then
docmd.quit
end if
使用 Shell 函数来完成一个用户指定的应用程序。
使用 Shell 函数来完成一个用户指定的应用程序。在 MacIntosh 上，默认的驱动名为 “HD” ，路径名称的每部分由冒号而非反斜线分隔。相似地，您可以指定 Macintosh 文件夹而非 \Windows.
' 将第二个参数值设成 1，可让该程序以正常大小的窗口完成，并且拥有焦点。
Dim RetVal
RetVal = Shell("C:\WINDOWS\CALC.EXE", 1) ' 完成Calculator。
Shell("C:\WINDOWS\hh.exe c:\a.chm", vbNormalFocus)
hh.exe 是打开chm的程序文件。
chm是帮助文件
对外部文件管理
Set fs = CreateObject("Scripting.FileSystemObject") '设置系统计算机的驱动器、文件夹和文件记录集
fs.CopyFile "c:\12345.txt", "c:\abcde.txt" '拷贝文件
或：filecopy c:\a.mdb,d:\b.mdb
fs.DeleteFile "c:\12345.txt" '删除刚拷贝的文本文件
打开外部数据库
Private Sub Command5_Click()
Dim aobject As String
'定义对象变量
Set aobject = openobject("e:\学生规范考查.mdb", True, False)
'打开名为学生规范考查.mdb的库
End Sub
提示用户插入软盘
如果驱动器中没有软盘则会出现错误，
程序应提供没有软盘的信息：
Sub InsertDisk()
On Error Resume Next
If IsError(MyFile=Dir(“a:”,vbVolume))=True Then
MsgBox “驱动器中没有软盘，请插入软盘！”
Exit Sub
End If
End Sub
向表中加新字段
CurrentDb.Execute "Alter Table 表名 Add Column 新字段名 Char(13)"
自定义函数 IsYlwjcct("窗体名") （如果指定的窗体打开，返回True）
Function IsYlwjcct(ByVal strFormName As String) As Boolean
Const conObjStateClosed = 0
Const conDesignView = 0
If SysCmd(acSysCmdGetObjectState,acForm,strFormName) <>conObjStateClosed Then
If Forms(strFormName).CurrentView<>conDesignView Then
IsYlwjcct=True
End If
End If
End Function
删除当前数据库的表的字段
CurrentDb.Execute "Alter Table 名表 Drop Column字段名"
使主程序窗口的X失效
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
打开模块
DoCmd.OpenModule "设置启用禁用shift", ""
隐藏当前活动窗体
me.Form.Visible=True
隐藏主窗口
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
在一个窗体中执行另一窗体的子程序
来源：爱赛思应用俱乐部 huanghai
DoCmd.OpenForm "窗体2"
Call Forms("窗体2").aaa
禁用主窗口最大化和最小化按钮
'声明
Private Declare Function GetSystemMenu Lib "user32.dll" _
(ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function RemoveMenu Lib "user32.dll" _
(ByVal hMenu As Long, ByVal uPosition As Long, ByVal uFlags As Long) As Long
'使用
Private Sub Form_Load()
Dim hSysMenu As Long
Dim retval As Long
hSysMenu = GetSystemMenu(hWndAccessApp, 0)
retval = RemoveMenu(hSysMenu, &HF120, &H0)
hSysMenu = GetSystemMenu(Me.hwnd, 0)
retval = RemoveMenu(hSysMenu, &HF120, &H0)
End Sub
让主窗口最大化和最小化按钮消失
'声明：
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)
'使用：
Private Sub Form_Load()
Dim lWnd As Long
lWnd = GetWindowLong(hWndAccessApp, GWL_STYLE)
lWnd = lWnd And Not (WS_MINIMIZEBOX)
lWnd = lWnd And Not (WS_MAXIMIZEBOX)
lWnd = SetWindowLong(hWndAccessApp, GWL_STYLE, lWnd)
End Sub
计时器触发
Me.Text4.Value = Now()
隐藏当前激活的工具条：
Dim dqgjt As Variant
Set dqgjt = CommandBars.ActiveMenuBar
dqgjt.Enabled = False
显示和隐藏自定义的工具条
DoCmd.ShowToolbar "你的工具条名称", acToolbarYes
DoCmd.ShowToolbar "你的工具条名称", acToolbarNo
隐藏主程序窗口：(详见示例库)
Option Compare Database
Option Explicit
Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1
Private Declare Function apiShowWindow Lib "user32" _
Alias "ShowWindow" (ByVal hWnd As Long, _
ByVal nCmdShow As Long) As Long
Private Sub Command0_Click()
If Me.Command0.Caption = "隐藏窗体" Then
Me.Command0.Caption = "显示窗体"
Call apiShowWindow(hWndAccessApp, SW_HIDE)
DoCmd.Restore
Else
Me.Command0.Caption = "隐藏窗体"
Call apiShowWindow(hWndAccessApp, SW_SHOWNORMAL)
DoCmd.Close acForm, "frm_main"
DoCmd.ShowToolbar "菜单栏", acToolbarYes
DoCmd.Restore
End If
End Sub
主窗口最小化：
DoCmd.RunCommand acCmdAppMinimize
用代码打开窗体中选项卡控件的某页
Me.选项卡控件名.Pages(n).SetFocus
其中n是要打开的页号（页号是从0开始的）
对不同视图中对象的标题进行设置
使用 Caption 属性可以对不同视图中对象的标题进行设置，为用户提供有用的信息：
字段标题用于指定通过从字段列表中拖动字段而创建的控件所附标签上的文本，并作为表或查询“数据表”视图中字段的列标题。
窗体标题用于指定在“窗体”视图中标题栏上显示的文本。
报表标题用于指定在“打印预览”中报表的标题。
按钮和标签标题用于指定在控件中显示的文本。
String 型，可读写。
expression.Caption
expression 必需。返回“Applies To”列表中的一个对象的表达式。

上一节 下一节