Option Explicit
Private mbOK As Boolean
Private moSourceBook As Workbook
Private moTargetBook As Workbook
Private Const MCSNODEKEYROOT As String = "VBAProject of Source"
Private mcolSelectedComponents As Collection
Public Sub Initialise()
Dim oBook As Workbook
cbxSource.Clear
cbxTarget.Clear
For Each oBook In Workbooks
cbxSource.AddItem oBook.Name
cbxTarget.AddItem oBook.Name
Next
HandleButtons
End Sub
Private Sub PopulateTree()
Dim nRootNode As MSComctlLib.Node
Dim nNode As MSComctlLib.Node
Dim oComp As vbide.VBComponent
Dim sParentNodeName As String
Dim bDo As Boolean
With trvVBAProject
.Nodes.Clear
If Not TargetBook Is Nothing Then
Set nRootNode = .Nodes.Add(, , MCSNODEKEYROOT, MCSNODEKEYROOT)
For Each oComp In SourceBook.VBProject.VBComponents
Select Case oComp.Type
Case vbext_ct_MSForm
sParentNodeName = "Userforms"
Case vbext_ct_StdModule
sParentNodeName = "Modules"
Case vbext_ct_ClassModule
sParentNodeName = "Class Modules"
Case vbext_ct_Document
sParentNodeName = "Microsoft Excel Objects"
End Select
If sParentNodeName = "Modules" Or sParentNodeName = "Class Modules" _
Or sParentNodeName = "Userforms" Then
bDo = True
Else
If IsIn(TargetBook.VBProject.VBComponents, oComp.Name) Then
bDo = True
Else
bDo = False
End If
End If
If bDo Then
Add2Node sParentNodeName, oComp
End If
Next
End If
End With
End Sub
Private Sub Add2Node(sKey As String, oComp As VBComponent)
Dim nNode As MSComctlLib.Node
With trvVBAProject
On Error Resume Next
Set nNode = .Nodes(sKey)
If nNode Is Nothing Then
Set nNode = .Nodes.Add(MCSNODEKEYROOT, tvwChild, sKey, sKey)
nNode.EnsureVisible
End If
Set nNode = .Nodes.Add(sKey, tvwChild, sKey & ", " & oComp.Name, oComp.Name)
nNode.EnsureVisible
End With
End Sub
Private Sub HandleButtons()
If cbxSource.Value = "" Or cbxTarget.Value = "" Then
cmbOK.Enabled = False
ElseIf cbxSource.Value = cbxTarget.Value Then
cmbOK.Enabled = False
Else
cmbOK.Enabled = True
End If
End Sub
Private Sub cbxSource_Change()
If cbxSource.Value <> "" Then
Set SourceBook = Workbooks(cbxSource.Value)
Else
Set SourceBook = Nothing
End If
HandleButtons
PopulateTree
End Sub
Private Sub cbxTarget_Change()
If cbxTarget.Value <> "" Then
Set TargetBook = Nothing
On Error Resume Next
Set TargetBook = Workbooks(cbxTarget.Value)
If Not TargetBook Is Nothing Then
PopulateTree
End If
Else
Set TargetBook = Nothing
End If
HandleButtons
End Sub
Private Sub cmbCancel_Click()
OK = False
Me.Hide
End Sub
Private Sub cmbOK_Click()
OK = True
Me.Hide
End Sub
Public Property Get OK() As Boolean
OK = mbOK
End Property
Public Property Let OK(ByVal bOK As Boolean)
mbOK = bOK
End Property
Public Property Get SourceBook() As Workbook
Set SourceBook = moSourceBook
End Property
Public Property Set SourceBook(objSourceBook As Workbook)
Set moSourceBook = objSourceBook
End Property
Public Property Get TargetBook() As Workbook
Set TargetBook = moTargetBook
End Property
Public Property Set TargetBook(objTargetBook As Workbook)
Set moTargetBook = objTargetBook
End Property
Private Sub trvVBAProject_BeforeLabelEdit(Cancel As Integer)
Cancel = True
End Sub
Private Sub trvVBAProject_NodeCheck(ByVal Node As MSComctlLib.Node)
Dim nNode As MSComctlLib.Node
Static bNoEvent As Boolean
If bNoEvent Then Exit Sub
bNoEvent = True
For Each nNode In trvVBAProject.Nodes
If Not nNode.Parent Is Nothing And Not nNode Is Node Then
If nNode.Parent Is Node Then
nNode.Checked = Node.Checked
ElseIf Not nNode.Parent.Parent Is Nothing Then
If nNode.Parent.Parent Is Node Then
nNode.Checked = Node.Checked
End If
End If
If nNode.ForeColor = vbGrayText Then
nNode.Checked = False
End If
End If
Next
bNoEvent = False
SetSelectedComponents
End Sub
Private Sub SetSelectedComponents()
Dim nNode As MSComctlLib.Node
Set mcolSelectedComponents = New Collection
For Each nNode In trvVBAProject.Nodes
If nNode.Children = 0 And nNode.Checked Then
mcolSelectedComponents.Add nNode.Key
End If
Next
End Sub
Public Property Get SelectedComponents() As Collection
Set SelectedComponents = mcolSelectedComponents
End Property
Public Property Set SelectedComponents(colSelectedComponents As Collection)
Set mcolSelectedComponents = colSelectedComponents
End Property
Private Sub trvVBAProject_NodeClick(ByVal Node As MSComctlLib.Node)
If Node.ForeColor = vbGrayText Then
Node.Checked = False
End If
End Sub
