본 글에서는 MS Access Tree View – Navigation 기능을 구현해 보도록 하겠습니다.
MS Access Tree View – Navigation
서브폼을 만들기 위해서 ‘tbl_Reqs’ 테이블을 드래그 앤 드롭하여 트리 뷰가 있는 폼으로 끌어놓습니다. 그러면 ‘하위 폼 마법사’가 자동으로 실행되며, 이름을 ‘frm_Reqs’로 변경한 뒤 ‘마침’ 버튼을 클릭합니다.
다음과 같이 폼이 선택되어 있는 상태에서 오른 클릭을 한 뒤 ‘새 창에서 하위 폼 보기’를 클릭하면 하위폼만 별도로 열 수 있습니다.
하위폼이 열린 상태에서 몇가지 변경을 진행하도록 하겠습니다. 먼저 ID_Type을 기존의 ‘텍스트 상자’에서 ‘콤보 상자’로 형태를 바꿔주도록 하겠습니다. ID_Type 텍스트 상자가 선택된 상태에서 오른클릭을 한 뒤 ‘변경’ -> ‘콤보 상자’를 순차적으로 클릭하여 양식을 바꿔줍니다.
ID_Type의 ‘행 원본’ 속성값을 아래의 값으로 입력해줍니다.
SELECT * FROM tbl_Type
‘형식’ 탭에서 ‘열 개수’는 2개로 ‘열 너비는 ‘0;3’을 입력합니다. tbl_Type 테이블이 2개의 컬럼으로 되어 있기 때문에 2개 컬럼값을 설정하는 것이며, 그 중 첫번째 ID에 해당하는 열을 숨기기 위해서 첫번째 열의 너비를 0으로 설정하였습니다.
PK_Req값은 변경되면 안되는 값이기 때문에 ‘데이터’ 탭에서 ‘잠금’ 속성을 예로 변경하였습니다.
폼 전체를 선택한 뒤 속성에서 ‘모두’ 탭에서 ‘기본 보기’ 옵션을 ‘단일 폼’으로 변경합니다.
기존에 작성한 코드를 다음과 같이 업데이트 합니다. 중간에 Node를 add 할 때 처음 프로그래밍 시에는 Key값을 반환하지 않았는데 Key를 반환하도록 변경하였습니다. 기존의 코드를 다음의 코드를 엎어쓰기 하면 됩니다.
Option Compare Database
Public Sub loadTreeView()
Dim tv As MSComctlLib.TreeView
Set tv = Forms("frm_treeView").treeReqs.Object
' Clear all node of treeView
tv.Nodes.Clear
Dim rsReqs As DAO.Recordset
Set rsReqs = CurrentDb.OpenRecordset("SELECT * FROM tbl_Reqs ORDER BY ID_Parent, dbl_Sort", dbOpenDynaset)
Dim strFind As String
strFind = "ID_Type = 1"
rsReqs.FindFirst strFind
Dim nodX As MSComctlLib.Node
Dim strBook As String
Do While Not rsReqs.NoMatch
Set nodX = tv.Nodes.Add(, , genReqKey(rsReqs!PK_Req), rsReqs!mem_Req)
nodX.Bold = True
strBook = rsReqs.Bookmark
addChildren tv, nodX, rsReqs, rsReqs!PK_Req
rsReqs.Bookmark = strBook
rsReqs.FindNext strFind
Loop
End Sub
Private Sub addChildren(tv As TreeView, nodParent As Node, rsReqs As DAO.Recordset, lngParentId As Long)
Dim strFind As String
strFind = "ID_Parent =" & lngParentId
rsReqs.FindFirst strFind
Dim nodX As Node
Dim strBook As String
Do While Not rsReqs.NoMatch
Set nodX = tv.Nodes.Add(nodParent, tvwChild, genReqKey(rsReqs!PK_Req), rsReqs!mem_Req)
Select Case rsReqs!ID_Type
Case 1 'Document
Case 2 'Header
nodX.Bold = True
Case 3 'Requirement
Case 4 ' Guide
nodX.ForeColor = vbBlue
End Select
strBook = rsReqs.Bookmark
addChildren tv, nodX, rsReqs, rsReqs!PK_Req
rsReqs.Bookmark = strBook
rsReqs.FindNext strFind
Loop
End Sub
Private Function genReqKey(lngReqID As Long) As String
genReqKey = "<Type>Req</Type><ID>" & lngReqID & "</ID>"
Debug.Print genReqKey
End Function
왼편에 프로젝트 탐색기에서 모듈을 추가한 뒤 이름을 ‘mod_Tools’로 변경합니다. 변경한 뒤에는 아래의 코드를 복사 붙여넣기 합니다.
Option Compare Database
Option Explicit
Public Const g_DebugMode As Boolean = True
Public Const g_ProjectName As String = "Treeview Demo"
Public Function getID(nodX As MSComctlLib.Node) As Long
On Error GoTo err_Handler
getID = getXML(nodX.Key, "ID")
exit_Function:
Exit Function
err_Handler:
doStdErrMsg ("getID Function")
GoTo exit_Function
End Function
Public Function getType(nodX As MSComctlLib.Node) As String
On Error GoTo err_Handler
getType = getXML(nodX.Key, "Type")
exit_Function:
Exit Function
err_Handler:
doStdErrMsg ("GetType")
GoTo exit_Function
End Function
Public Function getXML(strxml As String, strElement As String) As String
On Error GoTo errHandler
If InStr(1, strxml, "<" & strElement & ">", vbTextCompare) > 0 And InStr(1, strxml, "</" & strElement & ">", vbTextCompare) > 0 Then
'Found it
Dim intLeft As Integer
Dim intRight As Integer
intLeft = InStr(1, strxml, "<" & strElement & ">", vbTextCompare) + Len(strElement) + 2
intRight = InStr(1, strxml, "</" & strElement & ">", vbTextCompare)
getXML = Mid(strxml, intLeft, intRight - intLeft)
Else
GoTo badXML
End If
Exit Function
badXML:
MsgBox "An error occured while trying to retrieve XML information,probably due to bad tags", vbOKOnly + vbCritical, "Error reading Node information"
Exit Function
errHandler:
MsgBox "An error occured while trying to retrieve XML information from a node" & vbOKOnly + vbCritical, "Error reading Node information"
Err.Clear
Exit Function
End Function
Public Sub ExpandArray(ByRef InputArray As Variant, Optional lngExpansion As Long = 50)
Dim lngSize As Long
lngSize = lngExpansion + UBound(InputArray)
ReDim Preserve InputArray(lngSize)
End Sub
Public Sub StoreExpanded(tv As TreeView, ByRef strKeyArray() As String)
If Not g_DebugMode Then On Error GoTo err_Handler
Dim nodX As Node
ReDim strKeyArray(50) 'Notice the no preserve, so array is cleared between each use
Dim intI As Integer
intI = 1
For Each nodX In tv.Nodes
If nodX.Expanded Then
strKeyArray(intI) = nodX.Key
intI = intI + 1
End If
Next
exit_Sub:
Set nodX = Nothing
Exit Sub
err_Handler:
If Err.Number = 9 Then
ExpandArray strKeyArray
Resume
Else
doStdErrMsg "Document Treeview (Remember expanded nodes)"
Resume exit_Sub
End If
End Sub
Public Sub RestoreExpanded(tv As TreeView, strKeyArray() As String)
'Loop through
Dim intI As Integer
On Error Resume Next 'Disable error handling, nodes could have been deleted
For intI = 1 To UBound(strKeyArray)
tv.Nodes(strKeyArray(intI)).Expanded = True
Next
exit_Sub:
Exit Sub
End Sub
Public Sub doStdErrMsg(Optional strProcName As String)
'Small function to put in each error handler for unexpected errors
'Compose message string
Dim strMsg As String
strMsg = "An unexpexted error [" & Err.Number & "] has occured."
'If proc name was supplied, add it to string
If strProcName & "" <> "" Then
strMsg = strMsg & vbNewLine & "In procedure '" & strProcName & "'"
End If
'Add error description
strMsg = strMsg & vbNewLine & vbNewLine & Err.Description
'Post it
MsgBox strMsg, vbOKOnly + vbExclamation, g_ProjectName & ": Unexpected Error"
'logError strMsg
End Sub
전체 폼 뷰로 돌아와 서브 폼을 선택한 상태에서 서브폼의 이름을 기존의 frm_Reqs에서 ctrlSubForm으로 변경해 줍니다.
프로젝트 탐색기에서 폼을 더블클릭하여 코드 입력창을 띄운 뒤 ‘treeReqs’ 가 선택된 상태에서 오른편 목록중에서 ‘NodeClick’을 찾아 클릭합니다. 그럼 자동으로 코드가 생성되어 노드를 클릭하는 이벤트가 발생할 때 동작을 입력할 수 있는 기본 코드가 작성됩니다.
Private Sub treeReqs_NodeClick(ByVal Node As Object)
Me.ctrlSubForm.Form.RecordSource = "SELECT * FROM tbl_Reqs WHERE PK_Req=" & getID(Node)
End Sub위와 같이 코드 내용을 입력해 줍니다.
트리뷰 업데이트
폼에서 데이터가 수정될 때 트리뷰가 자동으로 업데이트 되도록 설정하겠습니다.
서브 폼을 선택한 뒤 ‘이벤트’에 ‘After Update’ 항목에 코드 편집기를 엽니다.
여기에서 폼이 변경되었을 때 자동으로 트리 뷰가 새롭게 그려지고 이전에 선택했던 Node를 지속적으로 선택하고 있을 수 있도록 아래의 코드를 추가해 줍니다.
Private Sub Form_AfterUpdate()
loadTreeView
Dim tv As MSComctlLib.TreeView
'Set tv = Me.Parent.treeReqs.Object
'tv.Nodes(genReqKey(Me!PK_Req)).Selected = True
'Set tv = Nothing
'Set tv = getTV
getTV.Nodes(genReqKey(Me!PK_Req)).Selected = True
End Sub