EXCEL VBA 项目用来遍历子窗口

yuxb57905

新建一个名叫UserForm1的窗体创建按钮CommandButton1，黏贴如下代码测试过可以运行，最好再优化一下
Private dwTotalFileNum As Long
Private Const GW_CHILD = 5
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDNEXT = 2
Private Const WM_GETTEXT = 13
Private Const EM_REPLACESEL = 194
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private 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
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any)
Public Function getText(hwnd As Long) As String
    Const WM_GETTEXT = &HD
    Const WM_GETTEXTLENGTH = &HE
    Dim byt() As Byte
    Dim TextLen As Long
    Dim strText As String
    TextLen = SendMessage(hwnd, WM_GETTEXTLENGTH, 0, 0)
    ReDim byt(1 To TextLen) As Byte
    strText = Space(TextLen)
    Call SendMessage(hwnd, WM_GETTEXT, ByVal TextLen + 1, byt(1))
    getText = StrConv(byt, vbUnicode)
End Function


Function GetCkText(hListWnd As Long, szClsName As String)
Dim t As Integer, i As Integer
Dim szCaption As String
szCaption = String$(255, 0)
Select Case szClsName
    Case "Button", "Static"
       i = GetWindowTextLength(hListWnd)
       GetWindowText hListWnd, szCaption, 250
       szCaption = Left$(szCaption, i)
    Case "Edit"
        szCaption = getText(hListWnd)

   ' Case "Static"
         
    Case Else
        
    End Select

GetCkText = szCaption
   
End Function
Private Sub ListAllWndFind(hwnd As Long, szFullPathM As String)
Dim t As Integer
Dim hListWnd As Long
Dim RetVa As Long
Dim szFilePath As String
Dim szFullPath As String
Dim szClsName As String
Dim szCaption As String
szCaption = String$(255, 0)
szClsName = String$(255, 0)
hListWnd = FindWindowEx(hwnd, 0, vbNullString, vbNullString)
   If hListWnd <> 0 Then
     Do
        szFilePath = Str(hListWnd)
        szFullPath = szFullPathM & szFilePath
        dwTotalFileNum = dwTotalFileNum + 1
        szClsName = String$(255, 0)
        RetVa = GetClassName(hListWnd, szClsName, 250)
        't = Len(szClsName)
        szClsName = Left$(szClsName, RetVa)
        
        szCaption = GetCkText(hListWnd, szClsName)
        
        Sheet1.Cells(dwTotalFileNum, 1) = dwTotalFileNum
        Sheet1.Cells(dwTotalFileNum, 2) = szFullPath
        Sheet1.Cells(dwTotalFileNum, 3) = szClsName
        Sheet1.Cells(dwTotalFileNum, 4) = szCaption
        
        If (FindWindowEx(hListWnd, 0, vbNullString, vbNullString)) Then
            ListAllWndFind hListWnd, szFullPath
        End If
     hListWnd = FindWindowEx(hwnd, hListWnd, vbNullString, vbNullString)
     Loop While (hListWnd <> 0)
    Else
     t = MsgBox("没找到主窗口", vbOKOnly)
   End If
End Sub



Private Sub CommandButton1_Click()

Dim t As Integer
Dim hwnd As Long
Dim szFileGPath As String
dwTotalFileNum = 0
hwnd = FindWindow(vbNullString, "计算器")
If hwnd <> 0 Then
szFileGPath = Str(hwnd)
ListAllWndFind hwnd, szFileGPath
Else: t = MsgBox("没找到主窗口", vbOKOnly)
End If
End Sub


Private Sub UserForm_Click()

hj170520

能设置下排版吗

ilpj

我的vba白学了，没看懂