8

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

每当我打开 VBA 编辑器或将其重新聚焦时,项目资源管理器都会扩展“Microsoft Excel 对象”(主要是工作表)并折叠模块,这与我想要的完全相反。

因为我在每个工作簿中有大约 15 个工作表,所以在资源管理器中看到所有这些工作表使得它非常不切实际,因为在 VBA 编辑器中我主要关心模块中的代码。

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

编辑:我添加了一张图片,以显示不需要的默认值。现在我希望默认为“Microsoft Excel 对象”折叠和“模块”展开:

在此处输入图像描述

编辑:该解决方案提供了一个宏。为了接近“默认”,我将它添加到 VBE 的命令栏,可通过以下快捷方式访问:我将答案的第二部分放在此处,并将其放入代码模块中。然后我应用这些说明来创建 CommandBar 条目。然后我在标题中所需字母的前面添加了 & 符号,现在我可以使用 Alt+t,t 折叠 Microsoft Excel 对象并打开其余部分。

4

4 回答 4

6

好的,所以这并不是想要的,因为它不会默认执行,但我认为它与您将要获得的一样接近,而且非常漂亮,所以就这样吧。

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

从那里开始,只需找到正确的手柄并进行正确的检查即可。 注意: VBIDE 窗口必须打开(不一定是可见的)才能工作。我建议也许在 VBIDE 中创建一个工具栏并在必要时触发它。

它适用于 Windows 7 上的 Office 2007/2010 32 位,您必须修改 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
于 2013-06-11T13:15:18.073 回答
3

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

于 2013-06-11T02:47:16.013 回答
0

我使用的一个不太复杂的解决方法是在 VB 密码保护工作簿中进行工作表开发*;它的 VBE 节点保持折叠状态,因此项目资源管理器保持不变。

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

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

于 2019-01-26T18:58:09.250 回答
-1

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

高温高压

于 2013-06-07T14:16:59.480 回答