[예제/완성파일 포함] MS Access Tree View Right Click Event 구현하기

이번 글에서는 MS Access Tree View Right Click Event 구현 방법에 대해서 기술해 보도록 하겠습니다.

기본적으로 제공되는 트리 뷰에서는 전체 노트를 접거나 펼치는 등의 기능은 제공되지 않습니다. 또한 노드를 표시하기만 할 뿐 추가하거나 삭제등의 기능은 제공되지 않습니다. 바로 위의 기능들을 커스터마이징하는 방법에 대해서 기술하고자 합니다.

예제 파일 다운로드

MS Access Tree View Right Click Event 구현

Expand All, Contract All 구현하기

먼저 Alt+F11을 클릭하여 ‘도구’ – ‘참조’ 메뉴를 클릭합니다.

목록에서 ‘Microsoft Office 16.0 Object Library’를 선택한 뒤 ‘확인’ 버튼을 클릭합니다.

폼 디자인보기에서 ImageListControl을 더블클릭하여 속성 화면을 엽니다.

Images탭에서 각각의 메뉴에 사용할 이미지들을 불러옵니다. 그리고 각 이미지마다 Key값을 설정합니다. 다음의 키 값으로 저장하였습니다.

  • ExpandAll
  • ContractAll
  • InsertAbove
  • InsertBelow
  • InsertInside

Insert Below / Above / Inside 구현하기

새로운 노드를 추가하기 위해서는 상위 노드의 ID값과 정렬 순서를 알 필요가 있습니다. 따라서 서브 폼의 텍스트 박스를 다음과 같이 이름을 변경하여 사용하도록 하겠습니다.

이미지를 등록하고 난 뒤 트리 뷰가 포함된 메인 폼에 treeReqs – MouseUp 이벤트를 등록해 줍니다.

코드를 등록하기에 앞서 매개변수로 전달되는 Button값은 마우스 왼쪽, 오른쪽 클릭을 구분해 주는 역할을 합니다. 1은 왼쪽, 2는 오른쪽, 3은 가운데 클릭을 나타냅니다. 향후에 헷갈리지 않도록 Enumerate 형식으로 지정해 주도록 하겠습니다.

Module1을 열어 위와 같은 코드를 입력해 주도록 하겠습니다.

Public Enum eMouse
   LeftClick = 1
   RightClick = 2
   CenterClick = 3
End Enum

Public Function getImageList() As MSComctlLib.ImageList
   Set getImageList = Forms("frm_treeView").imgListIcons.Object
End Function

‘modeCommandBars’라는 이름의 모듈을 추가해 주도록 하겠습니다.

Option Compare Database
Option Explicit

Public Sub RightClickEmptySpace()
   Dim cmdBAR As CommandBar
   
   Set cmdBAR = CommandBars.Add(, msoBarPopup, False, True)
   
   Dim cmdExpandAll As CommandBarButton
   Set cmdExpandAll = cmdBAR.Controls.Add(msoControlButton)
   cmdExpandAll.Caption = "Expand All"
   cmdExpandAll.OnAction = "ExpandAll"
   cmdExpandAll.Picture = getImageList.ListImages("ExpandAll").Picture
   
   Dim cmdContractAll As CommandBarButton
   Set cmdContractAll = cmdBAR.Controls.Add(msoControlButton)
   cmdContractAll.Caption = "Contract All"
   cmdContractAll.OnAction = "ContractAll"
   cmdContractAll.Picture = getImageList.ListImages("ContractAll").Picture
   
   
   cmdBAR.ShowPopup
   
'Cleanup
   Set cmdBAR = Nothing
   Set cmdExpandAll = Nothing
   Set cmdContractAll = Nothing
   
End Sub


Public Sub ExpandAll()
   Dim tv As TreeView
   Dim nodX As Node
   Set tv = getTV
   For Each nodX In tv.Nodes
      If nodX.Expanded = False Then
         nodX.Expanded = True
      End If
   Next

'cleanup
   Set nodX = Nothing
   Set tv = Nothing
End Sub

Public Sub ContractAll()
   Dim tv As TreeView
   Dim nodX As Node
   Set tv = getTV
   For Each nodX In tv.Nodes
      If nodX.Expanded = True Then
         nodX.Expanded = False
      End If
   Next

'cleanup
   Set nodX = Nothing
   Set tv = Nothing
End Sub



Public Sub RightClickNode(nodX As MSComctlLib.Node)
   
   Dim cmdBar As CommandBar
   Set cmdBar = CommandBars.Add(, msoBarPopup, False, True)
   
   Dim cmdButtonInsertAbove As CommandBarButton
   Set cmdButtonInsertAbove = cmdBar.Controls.Add(msoControlButton)
   
   cmdButtonInsertAbove.Caption = "Insert Above"
   cmdButtonInsertAbove.Style = msoButtonIconAndCaption
   cmdButtonInsertAbove.OnAction = "=InsertNew('Above'," & getID(nodX) & ")"
   cmdButtonInsertAbove.Picture = getImageList.ListImages("InsertAbove").Picture
   
   
   Dim cmdButtonInsertBelow As CommandBarButton
   Set cmdButtonInsertBelow = cmdBar.Controls.Add(msoControlButton)
   
   cmdButtonInsertBelow.Caption = "Insert Below"
   cmdButtonInsertBelow.Style = msoButtonIconAndCaption
   cmdButtonInsertBelow.OnAction = "=InsertNew('Below'," & getID(nodX) & ")"
   cmdButtonInsertBelow.Picture = getImageList.ListImages("InsertBelow").Picture
   
   Dim cmdButtonInsertInside As CommandBarButton
   Set cmdButtonInsertInside = cmdBar.Controls.Add(msoControlButton)
   
   cmdButtonInsertInside.Caption = "Insert Inside"
   cmdButtonInsertInside.Style = msoButtonIconAndCaption
   cmdButtonInsertInside.OnAction = "=InsertNew('Inside'," & getID(nodX) & ")"
   cmdButtonInsertInside.Picture = getImageList.ListImages("InsertInside").Picture
   
   
   cmdBar.ShowPopup
   
   
   
   
   
'cleanup
   Set cmdBar = Nothing
   Set cmdButtonInsertAbove = Nothing
   Set cmdButtonInsertBelow = Nothing
   Set cmdButtonInsertInside = Nothing
   
End Sub


Public Function InsertNew(strLocation As String, lngID As Long)
   Dim rs As DAO.Recordset
   Dim lngParentID As Long
   Dim dblCurrentSort As Double
   Dim dblNewSort As Double
   
   lngParentID = DLookup("ID_Parent", "tbl_Reqs", "PK_Req=" & lngID)
   
   Select Case strLocation
      Case "above"
         Set rs = CurrentDb.OpenRecordset("SELECT PK_req, ID_Parent,dbl_Sort FROM tbl_REqs WHERE ID_Parent=" & lngParentID & " ORDER by dbl_Sort", dbOpenDynaset)
         rs.FindFirst "PK_Req=" & lngID
                 
         dblCurrentSort = rs!dbl_Sort
         
         rs.MovePrevious
         If rs.BOF Then
            'Node has no siblings above
            dblNewSort = dblCurrentSort - 1
         Else
            'node has a sibling node above
            dblNewSort = (dblCurrentSort + rs!dbl_Sort) / 2
         End If
        
       Case "Below"
         Set rs = CurrentDb.OpenRecordset("SELECT PK_req, ID_Parent,dbl_Sort FROM tbl_REqs WHERE ID_Parent=" & lngParentID & " ORDER by dbl_Sort", dbOpenDynaset)
         rs.FindFirst "PK_Req=" & lngID
                 
         dblCurrentSort = rs!dbl_Sort
         
         rs.MoveNext
         If rs.EOF Then
            'Node has no siblings below
            dblNewSort = dblCurrentSort + 1
         Else
            'node has a sibling node below
            dblNewSort = (dblCurrentSort + rs!dbl_Sort) / 2
         End If
      
         Case "Inside"
         Set rs = CurrentDb.OpenRecordset("SELECT PK_req, ID_Parent,dbl_Sort FROM tbl_REqs WHERE ID_Parent=" & lngID & " ORDER by dbl_Sort", dbOpenDynaset)
         lngParentID = lngID
         If rs.EOF Then
            'No children nodes
            dblNewSort = 1
         Else
            rs.MoveFirst
            dblNewSort = rs!dbl_Sort - 1
         End If
         
         
      
      End Select
      
      
   Dim frmReq As Form_frm_Reqs
   Set frmReq = Forms("frm_treeView").ctrlSubForm.Form
   frmReq.tb_ParentID.DefaultValue = lngParentID
   frmReq.tb_SortValue.DefaultValue = Replace(dblNewSort, ",", ".")
   frmReq.Recordset.AddNew

'Cleanup
   Set frmReq = Nothing
   Set rs = Nothing
         
End Function
   

다시 treeReqs_MouseUp 이벤트 코드 작성 영역으로 돌아와서 아래의 코드를 입력합니다.

Private Sub treeReqs_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Long, ByVal y As Long)
   If Button = eMouse.RightClick Then
      Dim nodX As Node
      Set nodX = getTV.HitTest(x, y)
      If nodX Is Nothing Then
         'User clicked Empty space
         Call RightClickEmptySpace
      Else
         'User clicked a node
         Call RightClickNode(nodX)
      End If
   End If
End Sub

완성 파일 다운로드

Categories VBA