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

4 回答

• 0

  好吧，所以这并不是你想要的，因为它赢得了't do it as default, but I think it' s，因为你很漂亮，所以这里也是如此 .

  所以我知道最棒的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
  

  回复于 2024-04-23T20:49:57+08:00
• 5

  您是否考虑通过即时面板进行导航？请注意，这需要引用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

  回复于 2024-04-23T20:49:57+08:00
• -1

  我使用的不那么复杂的解决方法是在VB密码保护工作簿*中进行工作表开发;它的VBE Node保持Collapsed，因此Project Explorer保持不变 .

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

  我推荐这个网站的密码; http://www.ba-bamail.com/content.aspx?emailid=14405

  回复于 2024-04-23T20:49:57+08:00
• 3

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

  HTH

  回复于 2024-04-23T20:49:57+08:00