摘要本文完整演示如何在 Access 窗体里做一个类似资源管理器的树控件不用 TreeView OCX不用注册组件只用 WebBrowser 控件 一个 VBA 标准模块。文章包含控件清单、控件命名、窗体代码、模块源码、从表加载数据的方法复制即可测试。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。然后放下面这些控件。控件类型控件名作用WebBrowserWebBrowser0显示树控件文本框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父节点编号根节点固定写0text节点显示文字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获取选中节点 IDTreeGetText获取选中节点文字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 htmlhtmlhead S h, meta http-equivX-UA-Compatible contentIEedge S h, meta charsetutf-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, /headbody S h, div idtree-wrap/div S h, input typehidden id_treeSelectedId value S h, input typehidden id_treeSelectedText value S h, script typetext/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, _nodesdata||[]; _expanded{}; _selectedId; _searchKw; S h, for(var i0;i_nodes.length;i){_nodes[i]._idxi;} 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 i0;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, _searchKwtrimText(kw).toLowerCase(); S h, if(_searchKw){for(var i0;i_nodes.length;i){var txtString(_nodes[i].textnull?:_nodes[i].text).toLowerCase(); if(txt.indexOf(_searchKw)0){expandParents(_nodes[i].id);}}} S h, renderTree(); S h, } S h, function expandParents(id){var pidgetPid(id); while(pid pid!0){_expanded[pid]true; pidgetPid(pid);}} S h, function getPid(id){for(var i0;i_nodes.length;i){if(_nodes[i].idid){return _nodes[i].pid;}} return null;} S h, function getChildren(pid){var r[]; for(var i0;i_nodes.length;i){if(_nodes[i].pidpid){r[r.length]_nodes[i];}} return r;} S h, function hasChildren(id){for(var i0;i_nodes.length;i){if(_nodes[i].pidid){return true;}} return false;} S h, function trimText(v){return String(vnull?:v).replace(/^\s|\s$/g,);} S h, function htmlEncode(v){return String(vnull?:v).replace(//g,amp;).replace(//g,lt;).replace(//g,gt;).replace(//g,quot;).replace(//g,#39;);} S h, function highlightText(text){ S h, textString(textnull?:text); if(!_searchKw){return htmlEncode(text);} S h, var lowtext.toLowerCase(); var poslow.indexOf(_searchKw); S h, if(pos0){return htmlEncode(text);} S h, return htmlEncode(text.substring(0,pos))span classhithtmlEncode(text.substr(pos,_searchKw.length))/spanhtmlEncode(text.substring(pos_searchKw.length)); S h, } S h, function renderGuide(depth){var s; for(var i0;idepth;i){sspan classguide/span;} return s;} S h, function renderNode(node,depth){ S h, var hchasChildren(node.id); var open!!_expanded[node.id]; var idxnode._idx; S h, var cls(node.id_selectedId?selected :)(depth0?root :); S h, var togglehc?span classtoggle onclicktreeToggle(idx);return false;(open?#9662;:#9656;)/span:span classtoggle emptynbsp;/span; S h, var iconNameString(node.iconnull?:node.icon).toLowerCase(); S h, var ico(iconNamefile||(!hciconName!folder))?ico-file:ico-folder; S h, var htmldiv classtree-row cls onclicktreeSelect(idx);return false;; S h, htmlrenderGuide(depth)togglespan classicospan/span/spanspan classnode-texthighlightText(node.text)/span/div; S h, if(hc open){var chgetChildren(node.id); for(var i0;ich.length;i){htmlrenderNode(ch[i],depth1);}} S h, return html; S h, } S h, function renderTree(){var rootsgetChildren(0); var html; for(var i0;iroots.length;i){htmlrenderNode(roots[i],0);} document.getElementById(tree-wrap).innerHTMLhtml;} S h, function treeToggle(idx){var ewindow.event; if(e){e.cancelBubbletrue;} 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, _selectedIdn.id; S h, document.getElementById(_treeSelectedId).valuen.id; S h, document.getElementById(_treeSelectedText).valueString(n.textnull?:n.text); S h, renderTree(); S h, try{window.external.TreeNodeSelected(n.id,String(n.textnull?: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短文本节点 IDParentID短文本父节点 ID根节点填0NodeText短文本节点文字Icon短文本folder或fileSortNo数字排序示例数据NodeIDParentIDNodeTextIconSortNo10公司总部folder121研发中心folder232前端组folder343张三file453李四file5然后用下面代码加载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.wbTree2. 根节点的 pid 必须是字符串 0根节点这样写{id:1,pid:0,text:公司总部,icon:folder}不要写空也不要写 Null。3. WebBrowser 里不要写太新的 JSAccess 的 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读取选中 IDsId 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窗体上放WebBrowser02导入Module_Tree.bas3调用TreeInit Me.WebBrowser0, sData控件多一点没关系关键是命名要对。模块代码长一点也没关系关键是窗体调用要简单。我比较喜欢这种写法TreeInit Me.WebBrowser0, sData, light复杂的 HTML、CSS、JS 都藏在模块里。窗体上只保留几行能看懂的 VBA。这也是 Access 项目长期维护时很重要的一点不要让每个窗体都堆一大段重复代码把通用能力封装成模块。如果你正在做 Access 项目遇到产品分类、BOM、组织架构、菜单权限、左树右表这些需求可以直接照着这篇搭一个出来。后面还可以继续扩展比如节点双击、右键菜单、懒加载、勾选框、多选节点等。需要 Access 开发、培训、框架设计或系统改造的朋友可以添加 edonsoft 交流。
