只需 3 步,在 Access 里实现网页版树控件(含源码
Hi,大家好!
Access 里经常会遇到这种界面需求:
左边是一个分类树,右边是对应明细。
比如:
所有
成品类
通用零部件
标准件
专用零部件
GM电机
025
040
075
150
用户点左边的分类,右边的数据跟着变化。
这个界面很常见,产品分类、BOM、组织架构、菜单权限、项目目录都会用到。
但 Access 原生控件里没有一个特别省心的树控件。
以前很多人会用 Microsoft TreeView Control,也就是 MSCOMCTL.OCX 里的 TreeView。它能用,但也有几个麻烦点:
| 问题 | 表现 |
|---|
| 要注册 OCX | 换电脑容易出问题 |
| 32/64 位差异 | Office 位数不一样时容易踩坑 |
| 部署麻烦 | 客户电脑环境不统一时不好排查 |
| 样式不好改 | 想做成自己想要的样子不方便 |
所以这篇文章换一个思路:
用 Access 自带的 WebBrowser 控件显示一段 HTML 树,再用 VBA 和里面的 JS 通信。
最终效果是:
有小三角展开 / 折叠
有黄色文件夹图标和文件图标
点击节点可以选中
VBA 可以读到选中节点 ID 和文字
支持搜索、全部展开、全部折叠
可以从表或查询直接加载树数据
下面直接从零开始做。
一、最终要做出来的界面
窗体上主要分两块:
| 区域 | 控件 |
|---|
| 左侧或主体 | WebBrowser 控件,用来显示树 |
| 上方工具区 | 搜索框、搜索按钮、展开按钮、折叠按钮 |
| 下方或旁边 | Label,用来显示当前选中节点 |
树控件本身长这样:
▾ 公司总部
▾ 研发中心
▾ 前端组
张三
李四
▾ 后端组
王五
▾ 市场部
▾ 华北区
北京办事处
▸ 华南区
▾ 财务部
账务核算
出纳管理
其中:
| 显示元素 | 说明 |
|---|
▸ | 当前节点可展开,但现在是折叠状态 |
▾ | 当前节点已经展开 |
| 黄色文件夹 | 分类节点 |
| 白色文件 | 末级节点 |
| 灰色背景 | 当前选中的节点 |
二、先建窗体,放这些控件
新建一个空白窗体,命名为:frmTreeDemo。
然后放下面这些控件。
| 控件类型 | 控件名 | 作用 |
|---|
| WebBrowser | WebBrowser0 | 显示树控件 |
| 文本框 | txtSearch | 输入搜索关键字 |
| 按钮 | btnSearch | 搜索按钮 |
| 按钮 | btnExpandAll | 全部展开 |
| 按钮 | btnCollapseAll | 全部折叠 |
| 按钮 | btnGetSelected | 手动读取当前选中节点 |
| 标签 | lblSelected | 显示当前选中节点 |
注意两点:
WebBrowser 控件可以从 ActiveX 控件里插入,选择 Microsoft Web Browser。
如果 VBE 编译时提示类型相关问题,去 工具 -> 引用 里勾选 Microsoft Internet Controls。
控件大小可以自己调整。一般我会把 WebBrowser 放在窗体左侧,宽度 2500 到 3500 twips,高度占满主体区域。
三、树节点数据怎么写
这个树使用最常见的 id + pid 结构。
一条节点数据长这样:
{"id":"1","pid":"0","text":"公司总部","icon":"folder"}字段说明:
| 字段 | 说明 |
|---|
id | 节点唯一编号 |
pid | 父节点编号,根节点固定写 0 |
text | 节点显示文字 |
icon | 图标,常用 folder 或 file |
比如:
[
{"id":"1","pid":"0","text":"公司总部","icon":"folder"},
{"id":"2","pid":"1","text":"研发中心","icon":"folder"},
{"id":"3","pid":"2","text":"前端组","icon":"folder"},
{"id":"4","pid":"3","text":"张三","icon":"file"}
]显示出来就是:
公司总部
研发中心
前端组
张三
四、先导入标准模块 Module_Tree
打开 VBA 编辑器,菜单选择:
文件 -> 导入文件
导入下面这个标准模块,模块名叫:Module_Tree。
这个模块提供这些通用函数:
| 函数 | 作用 |
|---|
TreeInit | 初始化树控件 |
TreeSetData | 替换全部节点数据 |
TreeAddNode | 动态追加节点 |
TreeGetSelected | 获取选中节点 ID |
TreeGetText | 获取选中节点文字 |
TreeExpandAll | 全部展开 |
TreeCollapseAll | 全部折叠 |
TreeSearch | 搜索节点 |
TreeClear | 清空树 |
TreeFromRecordset | 从 Recordset 加载树 |
下面是完整源码。
Attribute VB_Name = "Module_Tree"
Option Compare Database
Option Explicit
'====================================================
' 模块名称: Module_Tree
' 功能描述: Access Web 控件 - 树控件 (TreeView)
' 版本: 1.0
'====================================================
Private Sub S(ByRef buf As String, ByVal line As String)
buf = buf & line & vbCrLf
End Sub
Public Sub TreeInit(ByVal wb As Object, _
Optional ByVal sData As String = "[]", _
Optional ByVal sTheme As String = "light", _
Optional ByVal nHeight As Long = 0)
Dim html As String
html = BuildTreeHTML(sData, sTheme, nHeight)
wb.Navigate "about:blank"
Do While wb.ReadyState <> 4
DoEvents
Loop
wb.Document.Write html
wb.Document.Close
End Sub
Public Sub TreeSetData(ByVal wb As Object, ByVal sData As String)
On Error Resume Next
wb.Document.parentWindow.execScript "treeSetData(" & sData & ")", "JScript"
End Sub
Public Sub TreeAddNode(ByVal wb As Object, _
ByVal sId As String, _
ByVal sPid As String, _
ByVal sText As String, _
Optional ByVal sIcon As String = "file")
Dim js As String
js = "treeAddNode({id:'" & EscJS(sId) & _
"',pid:'" & EscJS(sPid) & _
"',text:'" & EscJS(sText) & _
"',icon:'" & EscJS(sIcon) & "'})"
On Error Resume Next
wb.Document.parentWindow.execScript js, "JScript"
End Sub
Public Function TreeGetSelected(ByVal wb As Object) As String
On Error Resume Next
TreeGetSelected = wb.Document.getElementById("_treeSelectedId").Value
If Err.Number <> 0 Then TreeGetSelected = ""
End Function
Public Function TreeGetText(ByVal wb As Object) As String
On Error Resume Next
TreeGetText = wb.Document.getElementById("_treeSelectedText").Value
If Err.Number <> 0 Then TreeGetText = ""
End Function
Public Sub TreeExpandAll(ByVal wb As Object)
On Error Resume Next
wb.Document.parentWindow.execScript "treeExpandAll()", "JScript"
End Sub
Public Sub TreeCollapseAll(ByVal wb As Object)
On Error Resume Next
wb.Document.parentWindow.execScript "treeCollapseAll()", "JScript"
End Sub
Public Sub TreeSearch(ByVal wb As Object, ByVal sKeyword As String)
On Error Resume Next
wb.Document.parentWindow.execScript _
"treeSearch('" & EscJS(sKeyword) & "')", "JScript"
End Sub
Public Sub TreeClear(ByVal wb As Object)
On Error Resume Next
wb.Document.parentWindow.execScript "treeSetData([])", "JScript"
End Sub
Public Sub TreeFromRecordset(ByVal wb As Object, _
ByVal rs As Object, _
ByVal sIdField As String, _
ByVal sPidField As String, _
ByVal sTextField As String, _
Optional ByVal sIconField As String = "", _
Optional ByVal sTheme As String = "light")
Dim sData As String
Dim sId As String, sPid As String, sText As String, sIcon As String
Dim bFirst As Boolean
bFirst = True
sData = "["
Do While Not rs.EOF
sId = Nz(rs.Fields(sIdField).Value, "")
sPid = Nz(rs.Fields(sPidField).Value, "0")
sText = Nz(rs.Fields(sTextField).Value, "")
If sIconField <> "" Then
sIcon = Nz(rs.Fields(sIconField).Value, "file")
Else
sIcon = "file"
End If
If Not bFirst Then sData = sData & ","
sData = sData & "{""id"":""" & EscJS(sId) & """," & _
"""pid"":""" & EscJS(sPid) & """," & _
"""text"":""" & EscJS(sText) & """," & _
"""icon"":""" & EscJS(sIcon) & """}"
bFirst = False
rs.MoveNext
Loop
sData = sData & "]"
TreeInit wb, sData, sTheme
End Sub
Private Function EscJS(ByVal s As String) As String
s = Replace(s, "\", "\\")
s = Replace(s, "'", "\'")
s = Replace(s, """", "\""")
s = Replace(s, vbCrLf, "\n")
s = Replace(s, vbCr, "\n")
s = Replace(s, vbLf, "\n")
EscJS = s
End Function
Private Function BuildTreeHTML(ByVal sData As String, _
ByVal sTheme As String, _
ByVal nHeight As Long) As String
Dim h As String
Dim cBg As String, cFg As String, cHover As String
Dim cSelected As String, cLine As String, cSearch As String
Dim hStyle As String
If sTheme = "dark" Then
cBg = "#202124"
cFg = "#e8eaed"
cHover = "#2f3136"
cSelected = "#3a3d42"
cLine = "#696c72"
cSearch = "#6f5a18"
Else
cBg = "#ffffff"
cFg = "#1f1f1f"
cHover = "#f5f7fb"
cSelected = "#eeeeee"
cLine = "#b8b8b8"
cSearch = "#fff2a8"
End If
If nHeight > 0 Then
hStyle = "height:" & nHeight & "px;overflow:auto;"
Else
hStyle = "height:100%;overflow:auto;"
End If
S h, "<!DOCTYPE html><html><head>"
S h, "<meta http-equiv='X-UA-Compatible' content='IE=edge'>"
S h, "<meta charset='utf-8'>"
S h, "<style>"
S h, "html,body{width:100%;height:100%;margin:0;padding:0;background:" & cBg & ";color:" & cFg & ";font-family:'Segoe UI','Microsoft YaHei',SimSun,Arial,sans-serif;font-size:12px;}"
S h, "#tree-wrap{" & hStyle & "padding:2px 0 4px 0;white-space:nowrap;}"
S h, ".tree-row{height:22px;line-height:22px;cursor:default;white-space:nowrap;}"
S h, ".tree-row:hover{background:" & cHover & ";}"
S h, ".tree-row.selected{background:" & cSelected & ";}"
S h, ".tree-row.root .node-text{font-weight:600;}"
S h, ".toggle{display:inline-block;width:16px;height:22px;line-height:22px;text-align:center;color:#777;font-size:12px;vertical-align:middle;cursor:pointer;}"
S h, ".toggle.empty{cursor:default;color:transparent;}"
S h, ".guide{display:inline-block;width:18px;height:22px;border-left:1px dotted " & cLine & ";vertical-align:middle;margin-left:8px;}"
S h, ".ico-folder,.ico-file{position:relative;display:inline-block;vertical-align:middle;margin-right:5px;overflow:hidden;}"
S h, ".ico-folder{width:14px;height:10px;margin-left:2px;margin-top:2px;background:#d9b45f;border:1px solid #a47d2d;}"
S h, ".ico-folder span{position:absolute;left:1px;top:0;width:7px;height:3px;background:#f0d27a;border-right:1px solid #a47d2d;border-bottom:1px solid #a47d2d;overflow:hidden;}"
S h, ".ico-file{width:9px;height:12px;margin-left:4px;background:#f7f7f7;border:1px solid #9a9a9a;}"
S h, ".ico-file span{position:absolute;right:0;top:0;width:3px;height:3px;background:#dcdcdc;border-left:1px solid #9a9a9a;border-bottom:1px solid #9a9a9a;overflow:hidden;}"
S h, ".node-text{display:inline-block;vertical-align:middle;padding:0 3px 0 1px;color:" & cFg & ";text-decoration:none;}"
S h, ".tree-row.selected .node-text{color:" & cFg & ";}"
S h, ".hit{background:" & cSearch & ";color:#111;padding:0 1px;}"
S h, "</style>"
S h, "</head><body>"
S h, "<div id='tree-wrap'></div>"
S h, "<input type='hidden' id='_treeSelectedId' value=''>"
S h, "<input type='hidden' id='_treeSelectedText' value=''>"
S h, "<script type='text/javascript'>"
S h, "var _nodes=[];"
S h, "var _expanded={};"
S h, "var _selectedId='';"
S h, "var _searchKw='';"
S h, "var _initData=" & sData & ";"
S h, "function treeSetData(data){"
S h, " _nodes=data||[]; _expanded={}; _selectedId=''; _searchKw='';"
S h, " for(var i=0;i<_nodes.length;i++){_nodes[i]._idx=i;}"
S h, " document.getElementById('_treeSelectedId').value='';"
S h, " document.getElementById('_treeSelectedText').value='';"
S h, " renderTree();"
S h, "}"
S h, "function treeAddNode(node){node._idx=_nodes.length; _nodes.push(node); renderTree();}"
S h, "function treeExpandAll(){for(var i=0;i<_nodes.length;i++){if(hasChildren(_nodes[i].id)){_expanded[_nodes[i].id]=true;}} renderTree();}"
S h, "function treeCollapseAll(){_expanded={}; renderTree();}"
S h, "function treeSearch(kw){"
S h, " _searchKw=trimText(kw).toLowerCase();"
S h, " if(_searchKw){for(var i=0;i<_nodes.length;i++){var txt=String(_nodes[i].text==null?'':_nodes[i].text).toLowerCase(); if(txt.indexOf(_searchKw)>=0){expandParents(_nodes[i].id);}}}"
S h, " renderTree();"
S h, "}"
S h, "function expandParents(id){var pid=getPid(id); while(pid && pid!='0'){_expanded[pid]=true; pid=getPid(pid);}}"
S h, "function getPid(id){for(var i=0;i<_nodes.length;i++){if(_nodes[i].id==id){return _nodes[i].pid;}} return null;}"
S h, "function getChildren(pid){var r=[]; for(var i=0;i<_nodes.length;i++){if(_nodes[i].pid==pid){r[r.length]=_nodes[i];}} return r;}"
S h, "function hasChildren(id){for(var i=0;i<_nodes.length;i++){if(_nodes[i].pid==id){return true;}} return false;}"
S h, "function trimText(v){return String(v==null?'':v).replace(/^\s+|\s+$/g,'');}"
S h, "function htmlEncode(v){return String(v==null?'':v).replace(/&/g,'&').replace(/</g,'<').replace(/>/g,'>').replace(/""/g,'"').replace(/'/g,''');}"
S h, "function highlightText(text){"
S h, " text=String(text==null?'':text); if(!_searchKw){return htmlEncode(text);}"
S h, " var low=text.toLowerCase(); var pos=low.indexOf(_searchKw);"
S h, " if(pos<0){return htmlEncode(text);}"
S h, " return htmlEncode(text.substring(0,pos))+'<span class=""hit"">'+htmlEncode(text.substr(pos,_searchKw.length))+'</span>'+htmlEncode(text.substring(pos+_searchKw.length));"
S h, "}"
S h, "function renderGuide(depth){var s=''; for(var i=0;i<depth;i++){s+='<span class=""guide""></span>';} return s;}"
S h, "function renderNode(node,depth){"
S h, " var hc=hasChildren(node.id); var open=!!_expanded[node.id]; var idx=node._idx;"
S h, " var cls=(node.id==_selectedId?'selected ':'')+(depth==0?'root ':'');"
S h, " var toggle=hc?'<span class=""toggle"" onclick=""treeToggle('+idx+');return false;""'>+(open?'▾':'▸')+'</span>':'<span class=""toggle empty""> </span>';"
S h, " var iconName=String(node.icon==null?'':node.icon).toLowerCase();"
S h, " var ico=(iconName=='file'||(!hc&&iconName!='folder'))?'ico-file':'ico-folder';"
S h, " var html='<div class=""tree-row '+cls+'"" onclick=""treeSelect('+idx+');return false;""'+'>';"
S h, " html+=renderGuide(depth)+toggle+'<span class=""'+ico+'""><span></span></span><span class=""node-text"">'+highlightText(node.text)+'</span></div>';"
S h, " if(hc && open){var ch=getChildren(node.id); for(var i=0;i<ch.length;i++){html+=renderNode(ch[i],depth+1);}}"
S h, " return html;"
S h, "}"
S h, "function renderTree(){var roots=getChildren('0'); var html=''; for(var i=0;i<roots.length;i++){html+=renderNode(roots[i],0);} document.getElementById('tree-wrap').innerHTML=html;}"
S h, "function treeToggle(idx){var e=window.event; if(e){e.cancelBubble=true;} var n=_nodes[idx]; if(!n){return false;} _expanded[n.id]=!_expanded[n.id]; renderTree(); return false;}"
S h, "function treeSelect(idx){"
S h, " var n=_nodes[idx]; if(!n){return false;}"
S h, " _selectedId=n.id;"
S h, " document.getElementById('_treeSelectedId').value=n.id;"
S h, " document.getElementById('_treeSelectedText').value=String(n.text==null?'':n.text);"
S h, " renderTree();"
S h, " try{window.external.TreeNodeSelected(n.id,String(n.text==null?'':n.text));}catch(ex){}"
S h, " return false;"
S h, "}"
S h, "treeSetData(_initData);"
S h, "</script>"
S h, "</body></html>"
BuildTreeHTML = h
End Function五、窗体代码完整贴出来
标准模块导入以后,再回到 frmTreeDemo 的代码模块。
把下面代码复制进去。
Option Compare Database
Option Explicit
Private mLastSelectedId As String
Private Sub Form_Load()
Dim sData As String
sData = "["
sData = sData & "{""id"":""1"",""pid"":""0"",""text"":""公司总部"",""icon"":""folder""},"
sData = sData & "{""id"":""2"",""pid"":""1"",""text"":""研发中心"",""icon"":""folder""},"
sData = sData & "{""id"":""3"",""pid"":""2"",""text"":""前端组"",""icon"":""folder""},"
sData = sData & "{""id"":""4"",""pid"":""3"",""text"":""张三"",""icon"":""file""},"
sData = sData & "{""id"":""5"",""pid"":""3"",""text"":""李四"",""icon"":""file""},"
sData = sData & "{""id"":""6"",""pid"":""2"",""text"":""后端组"",""icon"":""folder""},"
sData = sData & "{""id"":""7"",""pid"":""6"",""text"":""王五"",""icon"":""file""},"
sData = sData & "{""id"":""8"",""pid"":""1"",""text"":""市场部"",""icon"":""folder""},"
sData = sData & "{""id"":""9"",""pid"":""8"",""text"":""华北区"",""icon"":""folder""},"
sData = sData & "{""id"":""10"",""pid"":""9"",""text"":""北京办事处"",""icon"":""file""},"
sData = sData & "{""id"":""11"",""pid"":""8"",""text"":""华南区"",""icon"":""folder""},"
sData = sData & "{""id"":""12"",""pid"":""1"",""text"":""财务部"",""icon"":""folder""},"
sData = sData & "{""id"":""13"",""pid"":""12"",""text"":""账务核算"",""icon"":""file""},"
sData = sData & "{""id"":""14"",""pid"":""12"",""text"":""出纳管理"",""icon"":""file""}"
sData = sData & "]"
TreeInit Me.WebBrowser0, sData, "light"
TreeExpandAll Me.WebBrowser0
Me.lblSelected.Caption = "请点击节点选择..."
Me.TimerInterval = 200
End Sub
Private Sub Form_Timer()
Dim sId As String
Dim sText As String
sId = TreeGetSelected(Me.WebBrowser0)
If sId <> mLastSelectedId Then
mLastSelectedId = sId
sText = TreeGetText(Me.WebBrowser0)
If sId = "" Then
Me.lblSelected.Caption = "请点击节点选择..."
Else
Me.lblSelected.Caption = "ID: " & sId & " | " & sText
End If
End If
End Sub
Private Sub btnSearch_Click()
TreeSearch Me.WebBrowser0, Me.txtSearch.Value
End Sub
Private Sub txtSearch_Change()
TreeSearch Me.WebBrowser0, Me.txtSearch.Text
End Sub
Private Sub txtSearch_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
TreeSearch Me.WebBrowser0, Me.txtSearch.Value
End If
End Sub
Private Sub btnExpandAll_Click()
TreeExpandAll Me.WebBrowser0
End Sub
Private Sub btnCollapseAll_Click()
TreeCollapseAll Me.WebBrowser0
End Sub
Private Sub btnGetSelected_Click()
Dim sId As String
Dim sText As String
sId = TreeGetSelected(Me.WebBrowser0)
sText = TreeGetText(Me.WebBrowser0)
If sId = "" Then
Me.lblSelected.Caption = "未选中任何节点"
Else
Me.lblSelected.Caption = "ID: " & sId & " | " & sText
End If
End Sub这里我用了一个 Form_Timer。
原因是节点点击发生在 WebBrowser 内部,Access 窗体本身不会像普通按钮那样自动触发事件。
所以我用每 200 毫秒读取一次选中 ID 的方式,只要发现选中节点变了,就更新 lblSelected。
这个方法简单,也够稳定。
六、从表里加载树数据
实际项目里,不建议一直手写 JSON。
更常见的做法是建一张树节点表。
表名可以叫:t_TreeNode。
字段设计如下:
| 字段名 | 类型 | 说明 |
|---|
| NodeID | 短文本 | 节点 ID |
| ParentID | 短文本 | 父节点 ID,根节点填 0 |
| NodeText | 短文本 | 节点文字 |
| Icon | 短文本 | folder 或 file |
| SortNo | 数字 | 排序 |
示例数据:
| NodeID | ParentID | NodeText | Icon | SortNo |
|---|
| 1 | 0 | 公司总部 | folder | 1 |
| 2 | 1 | 研发中心 | folder | 2 |
| 3 | 2 | 前端组 | folder | 3 |
| 4 | 3 | 张三 | file | 4 |
| 5 | 3 | 李四 | file | 5 |
然后用下面代码加载:
Private Sub LoadTreeFromTable()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset( _
"SELECT NodeID, ParentID, NodeText, Icon " & _
"FROM t_TreeNode ORDER BY SortNo", dbOpenSnapshot)
TreeFromRecordset Me.WebBrowser0, rs, _
"NodeID", "ParentID", "NodeText", "Icon", "light"
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub
以后要改树结构,就改表数据,不用改窗体代码。
七、几个容易出错的地方
1. WebBrowser 控件名字必须对
文章里的代码用的是:
Me.WebBrowser0
如果你的控件叫 wbTree,那所有地方都要改成:
Me.wbTree
2. 根节点的 pid 必须是字符串 0
根节点这样写:
{"id":"1","pid":"0","text":"公司总部","icon":"folder"}不要写空,也不要写 Null。
3. WebBrowser 里不要写太新的 JS
Access 的 WebBrowser 还是 IE/JScript 那套环境。
所以源码里尽量不用这些东西:
| 不建议写法 | 原因 |
|---|
let / const | 老 JScript 不支持 |
| 箭头函数 | 老 JScript 不支持 |
Array.find | 兼容性不稳 |
Array.filter | 兼容性不稳 |
| 复杂正则拼接 | 容易弹脚本错误 |
这也是为什么上面的 JS 看起来比较老派。
在 Access 里,稳定比新潮更重要。
4. 节点文字里有引号怎么办
如果节点文字里有单引号、双引号、换行,手工拼 JSON 时要小心。
更推荐从表里加载,或者用 TreeFromRecordset,模块里已经做了一层转义处理。
八、常用调用方式汇总
初始化:
TreeInit Me.WebBrowser0, sData, "light"
全部展开:
TreeExpandAll Me.WebBrowser0
全部折叠:
TreeCollapseAll Me.WebBrowser0
搜索:
TreeSearch Me.WebBrowser0, Me.txtSearch.Value
读取选中 ID:
sId = TreeGetSelected(Me.WebBrowser0)
读取选中文字:
sText = TreeGetText(Me.WebBrowser0)
从 Recordset 加载:
TreeFromRecordset Me.WebBrowser0, rs, "NodeID", "ParentID", "NodeText", "Icon"
九、适合用在哪里
这个树控件适合这些界面:
| 场景 | 用法 |
|---|
| 产品分类 | 左边分类树,右边产品列表 |
| BOM | 左边部件树,右边零件明细 |
| 组织架构 | 部门、岗位、人员分层展示 |
| 菜单权限 | 菜单层级展示和权限设置 |
| 项目资料 | 项目、阶段、文档分层 |
最常见的组合是:
左侧:WebBrowser 树控件
右侧:连续窗体或子窗体
当用户点击左侧树节点时,右侧子窗体按节点 ID 筛选。
示例:
Private Sub Form_Timer()
Dim sId As String
sId = TreeGetSelected(Me.WebBrowser0)
If sId <> mLastSelectedId Then
mLastSelectedId = sId
Me.subProduct.Form.Filter = "CategoryID='" & Replace(sId, "'", "''") & "'"
Me.subProduct.Form.FilterOn = True
End If
End Sub
这样就是一个典型的“左树右表”界面。
十、总结
这套方案的核心不是 Web 技术,而是把 Access 里不好用的树控件封装成一个模块。
以后再用树控件,只需要做三件事:
| 步骤 | 做什么 |
|---|
| 1 | 窗体上放 WebBrowser0 |
| 2 | 导入 Module_Tree.bas |
| 3 | 调用 TreeInit Me.WebBrowser0, sData |
控件多一点没关系,关键是命名要对。
模块代码长一点也没关系,关键是窗体调用要简单。
我比较喜欢这种写法:
TreeInit Me.WebBrowser0, sData, "light"
复杂的 HTML、CSS、JS 都藏在模块里。
窗体上只保留几行能看懂的 VBA。
这也是 Access 项目长期维护时很重要的一点:
不要让每个窗体都堆一大段重复代码,把通用能力封装成模块。
如果你正在做 Access 项目,遇到产品分类、BOM、组织架构、菜单权限、左树右表这些需求,可以直接照着这篇搭一个出来。
后面还可以继续扩展,比如节点双击、右键菜单、懒加载、勾选框、多选节点等。
需要 Access 开发、培训、框架设计或系统改造的朋友,可以添加 edonsoft 交流。