Закачете се в дъщерен клас SysTreeView32 на прозореца на VBE

Аз съм доста нов в извикванията на WinApi, въпреки че съм запознат с VBA. Това, което се опитвам да направя, е да се закача към дъщерен клас SysTreeView32 на прозореца на VBE (Project Explorer TreeView). Бих искал да разширя/свия елементите на дървовидния изглед, като модифицирам ключовете на системния регистър (или като алтернатива изпратя щракванията на мишката (mouse_event), въпреки че предпочитам първата опция).
Мога да намеря главния прозорец на Excel, като използвам този код:< br>

Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
              (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Sub Find_Window()
    Dim hWndExcel As Long
    hWndExcel = FindWindow("XLMAIN", Application.Caption)
    MsgBox hWndExcel
End Sub

С помощта на Window Detective мога да получа достъп до имената, свойствата и т.н. на детето класове.
Детствени класове на Window Detective
Но не мога да разбера как да осъществя достъп/активиране(или дори връща HWID на) дъщерния клас SysTreeView32 за свиване/разгъване на елементи (папки). Все още не съм сигурен как да повторя елементите, но ще проуча това след това. Проблемът тук е достъпът до класа SysTreeView32. Как мога да го постигна?

Когато се опитам да изпратя msgbox това
FindWindow("wndclass_desked_gsk", Application.Caption)
или
FindWindow("SysTreeView32", Application.Caption)
се връща 0, така че очевидно правя нещо нередно :/
Благодаря ти за твоето време.


api parent-child vba winapi
person Community    schedule 11.06.2013    source източник

Отговори (2)


arrow_upward
6
arrow_downward

трябва да използвате:

application.vbe.mainwindow.caption

ето примерен код за свиване

Private Const TVE_COLLAPSE = &H1
Private Const TVE_COLLAPSERESET = &H8000
Private Const TVE_EXPAND = &H2
Private Const TVE_EXPANDPARTIAL = &H4000
Private Const TVE_TOGGLE = &H3
Private Const TV_FIRST = &H1100
Private Const TVM_EXPAND = (TV_FIRST + 2)
Private Const TVM_GETNEXTITEM = (TV_FIRST + 10)
Private Const TVGN_ROOT = &H0
Private Const TVGN_NEXTVISIBLE = &H6

Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
                              (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                                    (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Sub CollapseProjects()
   Dim hWndVBE As Long, hWndPE As Long, hWndTvw As Long, hNode As Long, varReturn
   hWndVBE = FindWindowEx(0, 0, "wndclass_desked_gsk", Application.VBE.MainWindow.Caption)
   hWndPE = FindWindowEx(hWndVBE, 0, "PROJECT", vbNullString)
   hWndTvw = FindWindowEx(hWndPE, 0, "SysTreeView32", vbNullString)
   hNode = SendMessage(hWndTvw, TVM_GETNEXTITEM, TVGN_ROOT, 0&)
   Do While hNode <> 0
      varReturn = SendMessage(hWndTvw, TVM_EXPAND, TVE_COLLAPSE, hNode)
      hNode = SendMessage(hWndTvw, TVM_GETNEXTITEM, TVGN_NEXTVISIBLE, hNode)
   Loop
End Sub

в допълнение към вашия коментар, ето кода за свиване само на възлите „Microsoft Excel Objects“.

Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
                              (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                                    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SendMessageB Lib "user32" Alias "SendMessageA" _
                                     (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long

Private Const MAX_ITEM        As Long = 256
Private Const TV_FIRST        As Long = &H1100
Private Const TVM_EXPAND      As Long = (TV_FIRST + 2)
Private Const TVM_GETNEXTITEM As Long = (TV_FIRST + 10)
Private Const TVM_GETITEM     As Long = (TV_FIRST + 12)
Const TVE_COLLAPSE            As Long = &H1
Const TVE_EXPAND              As Long = &H2
Private Const TVGN_ROOT       As Long = &H0
Private Const TVGN_NEXT       As Long = &H1
Private Const TVIF_TEXT       As Long = &H1
Private Const TVGN_NEXTVISIBLE = &H6

Private Type TVITEM   ' was TV_ITEM
   mask                       As Long
   hItem                      As Long
   state                      As Long
   stateMask                  As Long
   pszText                    As String
   cchTextMax                 As Long
   iImage                     As Long
   iSelectedImage             As Long
   cChildren                  As Long
   lParam                     As Long
End Type


Sub CollapseXLObjects()
   Dim hWndVBE                As Long
   Dim hWndPE                 As Long
   Dim hWndTvw                As Long
   Dim hNode                  As Long
   Dim tvi                    As TVITEM
   Dim nChild                 As Long
   Dim sText                  As String
   Dim varReturn

   hWndVBE = FindWindowEx(0, 0, "wndclass_desked_gsk", Application.VBE.MainWindow.Caption)
   hWndPE = FindWindowEx(hWndVBE, 0, "PROJECT", vbNullString)
   hWndTvw = FindWindowEx(hWndPE, 0, "SysTreeView32", vbNullString)

   hNode = SendMessage(hWndTvw, TVM_GETNEXTITEM, TVGN_ROOT, 0&)

   Do While hNode <> 0
      tvi.hItem = hNode
      tvi.mask = TVIF_TEXT
      tvi.cchTextMax = MAX_ITEM
      tvi.pszText = String(MAX_ITEM, 0)
      nChild = SendMessageB(hWndTvw, TVM_GETITEM, 0&, tvi)
      If InStr(1, tvi.pszText, "Microsoft Excel Objects", vbTextCompare) > 0 Then
         varReturn = SendMessage(hWndTvw, TVM_EXPAND, TVE_COLLAPSE, hNode)
      Else
         varReturn = SendMessage(hWndTvw, TVM_EXPAND, TVE_EXPAND, hNode)
      End If
      hNode = SendMessage(hWndTvw, TVM_GETNEXTITEM, TVGN_NEXTVISIBLE, hNode)
   Loop
End Sub
person JosieP    schedule 11.06.2013
comment
+∞ това е просто перфектно! Просто ще трябва да го модифицирам, за да свия само обектите на Microsoft Excel, но мисля, че ще мога да го управлявам сам!... е, не мисля, че просто ще си играя с него сега и не съм напълно все още го разбирам - person ; 11.06.2013
comment
Актуализирах кода, за да проверя текста на възела и да скрия само обектите на Excel - person JosieP; 12.06.2013

arrow_upward
0
arrow_downward

Ако извиквам този под от друг под (в моя случай под в XL добавка, свързана с персонализиран бутон, който отваря VBE), и е маркиран друг модул (който може да е в друг проект), тогава открих

    Application.VBE.MainWindow.Caption

не работи. За да заснема маркирания модул, използвам:

    Private Sub VisualBasicEditor()
      On Error Resume Next
      WinName = "Microsoft Visual Basic - " + ActiveWorkbook.Name + " [Running] - [" + Application.VBE.ActiveCodePane.CodeModule.Name + " (Code)]"
      Application.VBE.MainWindow.Visible = True
      Call CollapseXLObjects
    End Sub

и в модула, съдържащ Sub CollapseXLObjects declare

    Public WinName As String

и в Sub CollapseXLObjects

    hWndVBE = FindWindowEx(0, 0, "wndclass_desked_gsk", WinName)
person Adam Pride    schedule 28.10.2015