VB 用API读取别的软件的LISTBOX中的某项和项目的总数

Posted 2023-04-23

VB 用API读取别的软件的LISTBOX中的某项和项目的总数

我有原代码，给你吧，很好用的，你所要求的它都可以实现，界面如图。

使用很简单：启动后将鼠标移到别的软件的LISTBOX，按F5，软件LISTBOX的内容就被复制到它的LISTBOX中了。最下面是代码工程的下载地址：

‘Module1------------------------------

 Option Explicit

 Type POINTAPI

x As Long

y As Long

End Type

Public Const LB_GETTEXT = &H189

Public Const LB_GETCOUNT = &H18B

Public Declare Function SendMessageBynum& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)

Public Declare Function SendMessageByString& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String)

Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Long) As Integer

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long

Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

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

Public Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long

    

  Public Function EnumWindows_CBK(ByVal hwnd As Long, ByVal lParam As Long) As Long

          Form1.List1.AddItem Str(hwnd)

          EnumWindows_CBK = 1

  End Function

’Form1--------------------------------

  Option Explicit

            Dim win As Long

          Dim wintxt As String

          Dim i As Integer

          Dim MyStr As String

          Dim xy As POINTAPI

          Dim kq As Boolean

          Dim txt As String

Private Sub Form_Load()

kq = False

End Sub

Private Sub List1_Click()

  If List1.ListIndex >= 0 Then Text4 = List1.List(List1.ListIndex)

End Sub

Private Sub List2_Click()

  If List2.ListIndex >= 0 Then Text5 = List2.List(List2.ListIndex)

End Sub

Private Sub Timer1_Timer()

Dim i As Long

Dim TListCount As Long

Dim TListTexts As String

  GetCursorPos xy

  win = WindowFromPoint(xy.x, xy.y)

  MyStr = String(100, Chr$(0))

  List1.Clear

  EnumChildWindows win, AddressOf EnumWindows_CBK, 1

  Text1.Text = List1.ListCount

  For i = 0 To List1.ListCount - 1

    GetWindowText Val(List1.List(i)), MyStr, 100

    List1.List(i) = List1.List(i) & "  " & MyStr

  Next

  txt = String(100, Chr$(0))

  GetWindowText win, txt, 100

  Text2.Text = Str(win) & "  " & txt

  

  TListCount = SendMessageBynum&(win, LB_GETCOUNT, 0&, 0&)'得到项目数

  Text3 = TListCount

  List2.Clear

  For i = 0 To TListCount - 1'将内容添加到列表框

    TListTexts = String$(255, 0)

    SendMessageByString& win, LB_GETTEXT, i, TListTexts

    TListTexts = Left$(TListTexts, InStr(1, TListTexts, Chr$(0)) - 1)

    List2.AddItem TListTexts

  Next i

End Sub

Private Function MyHotKey(vKeyCode) As Boolean

MyHotKey = (GetAsyncKeyState(vKeyCode) < 0)

End Function

Private Sub Timer2_Timer()

 

  If MyHotKey(vbKeyF5) Then

    If kq = False Then

    Timer1.Enabled = True

    kq = True

    Else

    Timer1.Enabled = False

    kq = False

    End If

    End If

End Sub

原代码工程下载地址：

http://www.mjbox.com/r/ww/wwccwwccwc/GetFormAndList.rar

参考技术A Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName 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 SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const LB_GETCOUNT = &H18B
Private Sub Command1_Click()
Dim WinWnd As Long
WinWnd = FindWindow(vbNullString, "Form1") '#Form1是对方应用程序的标题
'MsgBox WinWnd
If WinWnd <> 0 Then
hWnd2 = FindWindowEx(WinWnd, 0, "ThunderRT6ListBox", vbNullString)
If hWnd2 Then
ItemCount = SendMessage(hWnd2, LB_GETCOUNT, 0, 0)
MsgBox ItemCount
End If
End If
End Sub 参考技术B 似乎有点难度，如果那个软件也是你写的，可以将LISTBOX中的项保存到文件或数据库，然后这个软件再读取

怎样用VB读取Excel文件中表格中的数据？

天景花园2013年1月垃圾收集统计表
单位：公斤
日期 可回收物 厨余垃圾 有害垃圾 其他垃圾 总量
1月1日 58 110 0 117 285
1月2日 59 103 0 134 296
1月3日 60 105 0.5 139.5 305
1月4日 55 110 0 156 321
1月5日 58 115 0 157 330

1、VB是常用的应用软件开发工具之一，由于VB的报表功能有限，而且一但报表格式发生变化，就得相应修改程序，给应用软件的维护工作带来极大的不便。因此有很多程序员现在已经充分利用EXECL的强大报表功来实现报表功能。

2、 VB读写EXCEL表：VB本身提自动化功能可以读写EXCEL表，其方法如下：

第一步：在工程中引用Microsoft Excel类型库：从"工程"菜单中选择"引用"栏；选择Microsoft Excel 9.0 Object Library（EXCEL2000），然后选择"确定"。表示在工程中要引用EXCEL类型库。

第二步：在通用对象的声明过程中定义EXCEL对象：Dim xlApp As Excel.ApplicationDim xlBook As Excel.WorkBookDim xlSheet As Excel.Worksheet.

第三步：在运用以上VB命令操作EXCEL表时，除非设置EXCEL对象不可见，否则VB程序可继续执行其它操作，也能够关闭EXCEL，同时也可对EXCEL进行操作。但在EXCEL操作过程中关闭EXCEL对象时，VB程序无法知道，如果此时使用EXCEL对象，则VB程序会产生自动化错误。形成VB程序无法完全控制EXCEL的状况，使得VB与EXCEL脱节。

参考技术A Dim SheetID As Integer
Dim XlsRow As Long
Dim TotalBit As Integer
Dim MachineID00_Msg000(i) As String
Dim i As Integer
SheetID = 3 设定表编号，即Sheet的编号。
Set ExcelApp = CreateObject("Excel.Application") '
Set ExcelBook = ExcelApp.Workbooks.Open(App.Path + "\Pameter.dat") '路径
Set ExcelSheet = ExcelBook.Worksheets(SheetID) '
XlsRow = 2 '读取起始行
TotalBit = 16 '要读取的行数
For i = 0 To (TotalBit - 1)
MachineID00_Msg000(i) = ExcelSheet.Range("D" & XlsRow).value
XlsRow = XlsRow + 1 '循还
Next i
ExcelApp.quit
Set ExcelSheet = Nothing
Set ExcelBook = Nothing
Set ExcelApp = Nothing本回答被提问者采纳 参考技术B 不需要VB，就可以直接读取表格的数据。还可以对表格的数据进行需要的计算、汇总、统计等。