Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

VBE How to collapse worksheets by default

I work with several workbooks containing 10-15 Worksheets and several modules.

Whenever I open the VBA-Editor, or bring it back into focus, the project explorer has expanded the "Microsoft Excel objects" (mostly worksheets) and collapsed the moduls, which is exactly the opposite of what I want.

As I have about 15 Worksheets in each workbook, seeing all of them in the explorer makes it very impractical, as in the VBA-Editor i am mainly concerned about the code in the modules.

How can I change the default to: "Show modules and collapse 'Microsoft Excel objects' in the Project viewer"?

Edit: I added a picture, to show the unwanted default. Now i would like the default to be "Microsoft Excel Objects" collapsed and "Modules" expanded instead:

enter image description here

Edit: The solution provided a macro. To come close to the "default" I added it to the commandbar of the VBE, accessible with a shortcut-stroke as follows: I took the second part of the answer to mehow's question here and put it in a code module. Then I applied these instructions, to create the CommandBar entry. Then I Added the ampersand in front of the desired letter in the caption and now I can use Alt+t,t to collapse the Microsoft Excel Objects and open the rest.

like image 630
user1965813 Avatar asked Jun 07 '13 06:06

user1965813


2 Answers

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
like image 151
CuberChase Avatar answered Oct 11 '22 11:10

CuberChase


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

like image 38
dennythecoder Avatar answered Oct 11 '22 10:10

dennythecoder