Question

我使用包含10-15个工作表和几个模块的多个工作簿。

每当我打开VBA-Editor或重新关注它时，项目浏览器已经扩展了“Microsoft Excel对象”（主要是工作表）并折叠了模块，这与我想要的完全相反。

由于我在每个工作簿中有大约15个工作表，因此在资源管理器中查看所有工作表非常不切实际，因为在VBA编辑器中我主要关注模块中的代码。

如何将默认设置更改为：“在项目查看器中显示模块并折叠'Microsoft Excel对象'”？

编辑：我添加了一张图片，以显示不需要的默认值。现在我希望默认为“Microsoft Excel Objects”折叠，而“模块”则展开：

enter image description here

编辑：解决方案提供了一个宏。为了接近“默认”，我将它添加到VBE的命令栏中，可以使用快捷键处理，如下所示：我将答案的第二部分放到mehow的问题here并将其放在代码模块中。然后我应用了these指令来创建CommandBar条目。然后我在标题中的所需字母前添加了＆符号，现在我可以使用Alt + t，t来折叠Microsoft Excel对象并打开其余部分。

Answer 1

好的，所以这不是正是你想要的东西，因为它不会默认，但我认为它就像你要得到的那样接近它而且很漂亮所以在这里。

所以我知道最棒的MZTools（http://www.mztools.com/v3/mztools3.aspx）能够折叠树视图中的所有节点。因此，我搜索了一下以了解如何通过Win32API操纵VBA项目树视图。我从这个页面获得的大多数API调用：http://btmtz.mvps.org/treeview/（上次更新1999 !!）。

从那里只需要获得正确的手柄并进行正确的检查。 注意： VBIDE窗口必须打开（不一定是可见的）才能生效。我建议也许在VBIDE中创建一个工具栏并根据需要触发它。

它适用于Windows 7中的Office 2007/2010 32Bit，您必须修改64位的Win32API，但这并不难。您还可以根据需要优化某些项目的折叠/扩展等。

这是一个问题：

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

这些是Win32API声明：

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

Answer 2

您是否考虑通过即时面板进行导航？请注意，这需要引用Visual Basic for Applications Extensibility 5.3。

包括ShowComponentByName，ShowOnlyModulesAndClasses和ListModulesAndClasses方法。

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

您可能需要更改安全设置，可以这样做： http://support.microsoft.com/kb/813969

此致 LC

Answer 3

我使用的一种较简单的解决方法是在VB密码保护的工作簿中进行工作表开发*； VBE节点保持折叠状态，因此Project Explorer保持不变。

*右键单击工作簿节点>属性>保护>锁定项目以查看输入密码

我建议从此站点输入密码； http://www.ba-bamail.com/content.aspx?emailid=14405

Answer 4

这适用于Excel 2010：在VBA编辑器中转到Window＆gt; Options并检查Collapse Proj. Hides Windows选项。然后关闭所有Microsoft Excel对象窗口并折叠项目资源管理器中的Microsoft Excel对象组。保存工作簿，关闭，当您重新打开时，只有模块将打开。

HTH

VBE默认情况下如何折叠工作表

4 个答案: