VBE How to collapse worksheets by default
Ok, so this isn't precisely what you want in that it won't do it as default, but I think it's as close as you're going to get and it's pretty nifty so here goes.
So I know the most awesome MZTools (http://www.mztools.com/v3/mztools3.aspx) has the ability to collapse all nodes in the treeview. Therefore, I searched a bit to find out how to manipulate the VBA Project treeview via Win32APIs. Most of the API calls I got from this page: http://btmtz.mvps.org/treeview/ (last update 1999!!).
From there it was just a matter of getting the right handles and doing the right checks. Note: The VBIDE window must be open (doesn't have to be visible) for this to work. I'd suggest perhaps creating a toolbar in the VBIDE and firing it as necessary.
It works for me in Office 2007/2010 32Bit on Windows 7, you'd have to modify the Win32APIs for 64Bit but that wouldn't be hard. You could also refine the collapsing/expanding for certain projects etc based on what you need.
This is the proceedure:
Sub CollapseVBIDETree()
Dim hwndVBIDE As Long, hwndVBAProj As Long, hwndTV As Long
Dim hwndCurrent As Long, hwndChildCurrent As Long
Dim bSuccessModule As Boolean, bSuccessElse As Boolean, sNodeName As String
'Find the handle of the VBEIDE window, down to the treeview in the project window
hwndVBIDE = FindWindow("wndclass_desked_gsk", vbNullString) 'VBIDE Window
hwndVBAProj = FindWindowEx(hwndVBIDE, 0&, "PROJECT", vbNullString) 'The Project - VBAProject Window
hwndTV = FindWindowEx(hwndVBAProj, 0&, "SysTreeView32", vbNullString) 'The Treeview in the VBAProject Window
'Get the handle of the Root of the Treeview
hwndCurrent = TreeView_GetRoot(hwndTV)
'Loop through all the children of the treeview. This is all the current VBA Projects.
'We can loop through until there are none left and a handle of zero is return
Do While hwndCurrent <> 0
sNodeName = GetTVItemText(hwndTV, hwndCurrent)
'Get the first child in the current project which is the 'Microsoft Excel Objects'
hwndChildCurrent = TreeView_GetChild(hwndTV, hwndCurrent)
'Set up a boolean to check if there is a 'Modules' child. If not, we'll collapse the whole project
bSuccessModule = False
'Loop through all the child nodes to find the 'Modules' node
Do While hwndChildCurrent <> 0
'Get the name of the node
sNodeName = GetTVItemText(hwndTV, hwndChildCurrent)
'If we find the Modules node then Expand it and flag it
If sNodeName = "Modules" Then
bSuccessModule = TreeView_Expand(hwndTV, hwndChildCurrent, TVE_EXPAND)
Else
'Otherwise collapse it
bSuccessElse = TreeView_Expand(hwndTV, hwndChildCurrent, TVE_COLLAPSE)
End If
hwndChildCurrent = TreeView_GetNextSibling(hwndTV, hwndChildCurrent)
Loop
'If we don't find a Modules child then collapse the entire branch for that project
If Not bSuccessModule Then
Call TreeView_Expand(hwndTV, hwndCurrent, TVE_COLLAPSE)
Else
'Some workbooks if collapsed would stay collapsed so make sure they are expanded
Call TreeView_Expand(hwndTV, hwndCurrent, TVE_EXPAND)
End If
'Move onto the next project
hwndCurrent = TreeView_GetNextSibling(hwndTV, hwndCurrent)
Loop
End Sub
And these are the Win32API declarations:
Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
ByVal hWndParent As Long, _
ByVal hWndChildAfter As Long, _
ByVal lpszClassName As String, _
ByVal lpszWindowName As String) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
wParam As Any, _
lParam As Any) As Long
' ===========================================================================
' treeview definitions defined in Commctrl.h at:
' http://premium.microsoft.com/msdn/library/sdkdoc/c67_4c8m.htm
Public Type TVITEM ' was TV_ITEM
mask As Long
hItem As Long
State As Long
stateMask As Long
pszText As String ' Long ' pointer
cchTextMax As Long
iImage As Long
iSelectedImage As Long
cChildren As Long
lParam As Long
End Type
'
Public Enum TVITEM_mask
TVIF_TEXT = &H1
TVIF_IMAGE = &H2
TVIF_PARAM = &H4
TVIF_STATE = &H8
TVIF_HANDLE = &H10
TVIF_SELECTEDIMAGE = &H20
TVIF_CHILDREN = &H40
#If (Win32_IE >= &H400) Then ' WIN32_IE = 1024 (>= Comctl32.dll v4.71)
TVIF_INTEGRAL = &H80
#End If
TVIF_DI_SETITEM = &H1000 ' Notification
End Enum
' User-defined as the maximum treeview item text length.
' If an items text exceeds this value when calling GetTVItemText
' there could be problems...
Public Const MAX_ITEM = 256
' TVM_GETNEXTITEM wParam values
Public Enum TVGN_Flags
TVGN_ROOT = &H0
TVGN_NEXT = &H1
TVGN_PREVIOUS = &H2
TVGN_PARENT = &H3
TVGN_CHILD = &H4
TVGN_FIRSTVISIBLE = &H5
TVGN_NEXTVISIBLE = &H6
TVGN_PREVIOUSVISIBLE = &H7
TVGN_DROPHILITE = &H8
TVGN_CARET = &H9
#If (Win32_IE >= &H400) Then ' >= Comctl32.dll v4.71
TVGN_LASTVISIBLE = &HA
#End If
End Enum
Public Enum TVMessages
TV_FIRST = &H1100
#If UNICODE Then
TVM_INSERTITEM = (TV_FIRST + 50)
#Else
TVM_INSERTITEM = (TV_FIRST + 0)
#End If
TVM_DELETEITEM = (TV_FIRST + 1)
TVM_EXPAND = (TV_FIRST + 2)
TVM_GETITEMRECT = (TV_FIRST + 4)
TVM_GETCOUNT = (TV_FIRST + 5)
TVM_GETINDENT = (TV_FIRST + 6)
TVM_SETINDENT = (TV_FIRST + 7)
TVM_GETIMAGELIST = (TV_FIRST + 8)
TVM_SETIMAGELIST = (TV_FIRST + 9)
TVM_GETNEXTITEM = (TV_FIRST + 10)
TVM_SELECTITEM = (TV_FIRST + 11)
#If UNICODE Then
TVM_GETITEM = (TV_FIRST + 62)
TVM_SETITEM = (TV_FIRST + 63)
TVM_EDITLABEL = (TV_FIRST + 65)
#Else
TVM_GETITEM = (TV_FIRST + 12)
TVM_SETITEM = (TV_FIRST + 13)
TVM_EDITLABEL = (TV_FIRST + 14)
#End If
TVM_GETEDITCONTROL = (TV_FIRST + 15)
TVM_GETVISIBLECOUNT = (TV_FIRST + 16)
TVM_HITTEST = (TV_FIRST + 17)
TVM_CREATEDRAGIMAGE = (TV_FIRST + 18)
TVM_SORTCHILDREN = (TV_FIRST + 19)
TVM_ENSUREVISIBLE = (TV_FIRST + 20)
TVM_SORTCHILDRENCB = (TV_FIRST + 21)
TVM_ENDEDITLABELNOW = (TV_FIRST + 22)
#If UNICODE Then
TVM_GETISEARCHSTRING = (TV_FIRST + 64)
#Else
TVM_GETISEARCHSTRING = (TV_FIRST + 23)
#End If
#If (Win32_IE >= &H300) Then
TVM_SETTOOLTIPS = (TV_FIRST + 24)
TVM_GETTOOLTIPS = (TV_FIRST + 25)
#End If ' 0x0300
#If (Win32_IE >= &H400) Then
TVM_SETINSERTMARK = (TV_FIRST + 26)
TVM_SETUNICODEFORMAT = CCM_SETUNICODEFORMAT
TVM_GETUNICODEFORMAT = CCM_GETUNICODEFORMAT
TVM_SETITEMHEIGHT = (TV_FIRST + 27)
TVM_GETITEMHEIGHT = (TV_FIRST + 28)
TVM_SETBKCOLOR = (TV_FIRST + 29)
TVM_SETTEXTCOLOR = (TV_FIRST + 30)
TVM_GETBKCOLOR = (TV_FIRST + 31)
TVM_GETTEXTCOLOR = (TV_FIRST + 32)
TVM_SETSCROLLTIME = (TV_FIRST + 33)
TVM_GETSCROLLTIME = (TV_FIRST + 34)
TVM_SETINSERTMARKCOLOR = (TV_FIRST + 37)
TVM_GETINSERTMARKCOLOR = (TV_FIRST + 38)
#End If ' 0x0400
End Enum ' TVMessages
Public Enum TVM_EXPAND_wParam
TVE_COLLAPSE = &H1
TVE_EXPAND = &H2
TVE_TOGGLE = &H3
#If (Win32_IE >= &H300) Then
TVE_EXPANDPARTIAL = &H4000
#End If
TVE_COLLAPSERESET = &H8000
End Enum
' Returns the text of the specified treeview item if successful,
' returns an empty string otherwise.
' hwndTV - treeview's window handle
' hItem - item's handle whose text is to be to returned
' cbItem - length of the specified item's text.
Public Function GetTVItemText(hwndTV As Long, hItem As Long, Optional cbItem As Long = MAX_ITEM) As String
Dim tvi As TVITEM
' Initialize the struct to retrieve the item's text.
tvi.mask = TVIF_TEXT
tvi.hItem = hItem
tvi.pszText = String$(cbItem, 0)
tvi.cchTextMax = cbItem
If TreeView_GetItem(hwndTV, tvi) Then
GetTVItemText = GetStrFromBufferA(tvi.pszText)
End If
End Function
' Returns the string before first null char encountered (if any) from an ANSII string.
Public Function GetStrFromBufferA(sz As String) As String
If InStr(sz, vbNullChar) Then
GetStrFromBufferA = Left$(sz, InStr(sz, vbNullChar) - 1)
Else
' If sz had no null char, the Left$ function
' above would return a zero length string ("").
GetStrFromBufferA = sz
End If
End Function
' Expands or collapses the list of child items, if any, associated with the specified parent item.
' Returns TRUE if successful or FALSE otherwise.
' (docs say TVM_EXPAND does not send the TVN_ITEMEXPANDING and
' TVN_ITEMEXPANDED notification messages to the parent window...?)
Public Function TreeView_Expand(hwnd As Long, hItem As Long, flag As TVM_EXPAND_wParam) As Boolean
TreeView_Expand = SendMessage(hwnd, TVM_EXPAND, ByVal flag, ByVal hItem)
End Function
' Retrieves some or all of a tree-view item's attributes.
' Returns TRUE if successful or FALSE otherwise.
Public Function TreeView_GetItem(hwnd As Long, pitem As TVITEM) As Boolean
TreeView_GetItem = SendMessage(hwnd, TVM_GETITEM, 0, pitem)
End Function
' Retrieves the tree-view item that bears the specified relationship to a specified item.
' Returns the handle to the item if successful or 0 otherwise.
Public Function TreeView_GetNextItem(hwnd As Long, hItem As Long, flag As Long) As Long
TreeView_GetNextItem = SendMessage(hwnd, TVM_GETNEXTITEM, ByVal flag, ByVal hItem)
End Function
' Retrieves the first child item. The hitem parameter must be NULL.
' Returns the handle to the item if successful or 0 otherwise.
Public Function TreeView_GetChild(hwnd As Long, hItem As Long) As Long
TreeView_GetChild = TreeView_GetNextItem(hwnd, hItem, TVGN_CHILD)
End Function
' Retrieves the next sibling item.
' Returns the handle to the item if successful or 0 otherwise.
Public Function TreeView_GetNextSibling(hwnd As Long, hItem As Long) As Long
TreeView_GetNextSibling = TreeView_GetNextItem(hwnd, hItem, TVGN_NEXT)
End Function
' Retrieves the previous sibling item.
' Returns the handle to the item if successful or 0 otherwise.
Public Function TreeView_GetPrevSibling(hwnd As Long, hItem As Long) As Long
TreeView_GetPrevSibling = TreeView_GetNextItem(hwnd, hItem, TVGN_PREVIOUS)
End Function
' Retrieves the parent of the specified item.
' Returns the handle to the item if successful or 0 otherwise.
Public Function TreeView_GetParent(hwnd As Long, hItem As Long) As Long
TreeView_GetParent = TreeView_GetNextItem(hwnd, hItem, TVGN_PARENT)
End Function
' Retrieves the first visible item.
' Returns the handle to the item if successful or 0 otherwise.
Public Function TreeView_GetFirstVisible(hwnd As Long) As Long
TreeView_GetFirstVisible = TreeView_GetNextItem(hwnd, 0, TVGN_FIRSTVISIBLE)
End Function
' Retrieves the topmost or very first item of the tree-view control.
' Returns the handle to the item if successful or 0 otherwise.
Public Function TreeView_GetRoot(hwnd As Long) As Long
TreeView_GetRoot = TreeView_GetNextItem(hwnd, 0, TVGN_ROOT)
End Function
Have you considered navigating via the Immediate Panel? Note that this requires a reference to Visual Basic for Applications Extensibility 5.3.
ShowComponentByName, ShowOnlyModulesAndClasses, and ListModulesAndClasses methods are included.
Sub ShowOnlyModulesAndClasses()
'http://support.microsoft.com/kb/813969
Dim Editor As VBE
Dim Proj As VBProject
Dim Comps As VBComponents
Dim Comp As VBComponent
Set Editor = Application.VBE
For Each Proj In Editor.VBProjects
Set Comps = Proj.VBComponents
For Each Comp In Comps
If Comp.Type = vbext_ct_ClassModule Then
Comp.CodeModule.CodePane.Show
ElseIf Comp.Type = vbext_ct_StdModule Then
Comp.CodeModule.CodePane.Show
Else
Comp.CodeModule.CodePane.Window.Close
End If
Next Comp
Next Proj
Set Editor = Nothing
Set Proj = Nothing
Set Comps = Nothing
End Sub
Sub ShowComponentByName(CompName As String, Optional ByVal HideOthers As Boolean = True)
'http://support.microsoft.com/kb/813969
Dim Editor As VBE
Dim Proj As VBProject
Dim Comps As VBComponents
Dim Comp As VBComponent
Set Editor = Application.VBE
For Each Proj In Editor.VBProjects
Set Comps = Proj.VBComponents
For Each Comp In Comps
If UCase(Comp.Name) = UCase(CompName) Then
Comp.CodeModule.CodePane.Show
ElseIf HideOthers = True Then
Comp.CodeModule.CodePane.Window.Close
End If
Next Comp
Next Proj
Set Editor = Nothing
Set Proj = Nothing
Set Comps = Nothing
End Sub
Sub ListModulesAndClasses()
Dim Editor As VBE
Dim Proj As VBProject
Dim Comps As VBComponents
Dim Comp As VBComponent
Set Editor = Application.VBE
For Each Proj In Editor.VBProjects
Set Comps = Proj.VBComponents
For Each Comp In Comps
If Comp.Type = vbext_ct_ClassModule Then
Debug.Print Comp.Name
ElseIf Comp.Type = vbext_ct_StdModule Then
Debug.Print Comp.Name
End If
Next Comp
Next Proj
Set Editor = Nothing
Set Proj = Nothing
Set Comps = Nothing
End Sub
You may need to change a security setting, which can be done like this: http://support.microsoft.com/kb/813969
Regards, LC