好的,所以这并不是您想要的,因为它不会默认执行,但我认为它与您将要获得的一样接近,而且非常漂亮,所以就这样吧。
所以我知道最棒的 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