EXCEL VBA 项目用来遍历子窗口
新建一个名叫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() 能设置下排版吗
我的vba白学了，没看懂:'(weeqw
页:
[1]