VBA中API 函数集锦

作者：James Wong 来源：博客园 发布时间：2005-01-19 09:21 阅读：3148 次 原文链接 [收藏]

Following content copied from access911.net

API 函数在 VB 中得到了充分的运用，同时也让无数 VB 爱好者沉溺于其中。幸运的是 ACCESS 使用的 VBA 也能很好的引入 API 函数 1、如何让窗体总在最前面？

*API函数声明

Declare Function SetWindowPos Lib \l hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long 注释：常量声明

Private Const SWP_NOSIZE = &H1 Private Const SWP_NOMOVE = &H2 Private Const HWND_TOPMOST = -1 Private Const HWND_NOTOPMOST = -2 注释： 在某个form里写：

SetWindowPos me.hWnd,WND_TOPMOST,0,0,0,0, SWP_NOMOVE 注释：或下面 SetWindowPos me.hWnd,WND_TOPMOST,0,0,0,0, SWP_NOSIZE 2、使用API函数sendmessage，获得光标所在行和列。

Sub getcaretpos(byval TextHwnd&,LineNo&,ColNo&)

注释：TextHwnd为TextBox的hWnd属性值， LineNo为所在行数，ColNo为列数

dim I&,j&,k& 注释：获取起始位置到光标所在位置字节数 I=SendMessage(TextHwnd,&HB0&,0,0) j=I/2^16 注释：确定所在行 LineNo=SendMessage(TextHwnd,&HC9&,j,0)+1 注释：确定所在列

k=SendMessage(TextHwnd,&HBB&,-1,0) ColNo=j-k+1 End sub

3、如何以某种颜色填充某区域？

*API函数声明

Private Declare Sub FloodFill Lib \ X As Long, ByVal Y As _ Long, ByVal crColor As Long 注释：设(fillx,filly)为此区域内任一点

注释：Color为某种颜色

FloodFill Picture1.Hdc, fillx, filly,Color 4、如何关闭计算机？

！请注意你WINDOWS的版本

*API函数声明

Declare Function ExitWindows Lib \ByVal wReserved As Integer) As Integer 注释：执行 Dim DUMMY

DUMMY=ExitWindows(0，0)

强制关闭计算机：用API函数ExitWindowsEx可以实现强制关机，即便是您的应用程序尚未保存文件。

Private Declare Function ExitWindowsEx Lib \Long, ByVal dwReserved As Long) As Long Const EWX_SHUTDOWN = 1 Const EWX_LOGOFF = 0 Const EWX_REBOOT = 2 Const EWX_FORCE = 4

Private Sub Command1_Click() Dim a

a = ExitWindowsEx(EWX_LOGOFF or EWX_FORCE or EWX_SHUTDOWN, 0) End Sub 如果将

a = ExitWindowsEx(EWX_LOGOFF or EWX_FORCE or EWX_SHUTDOWN, 0) 改换为

a = ExitWindowsEx(EWX_LOGOFF or EWX_REBOOT, 0) 即可实现强制重启计算机！

5、如何获取Windows目录和System目录？

注释：复制以下代码到一模块中

Public Declare Function GetWindowsDirectory Lib \WindowsDirectoryA\ Long

Public Declare Function GetSystemDirectory Lib \ystemDirectoryA\ong

注释：在程序中调用

Dim WindowsDirectory As String, SystemDirectory As String, x As Long WindowsDirectory = Space(255) SystemDirectory = Space(255)

x = GetWindowsDirectory(WindowsDirectory, 255)

x = GetSystemDirectory(SystemDirectory, 255)

MsgBox \的安装目录是:\系统目录是:\6、如何建立简单的超级连接？

*API函数声明

Private Declare Function ShellExecute Lib \xecute A\ile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd A s Long) As Long 注释：打开某个网址

ShellExecute 0, \ring, 3

注释：给某个信箱发电子邮件

ShellExecute hwnd, %ullString, 0

7、如何得知TextBox中文字所有的行数？

*API函数声明

Declare Function SendMessage Lib \ hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Const EM_GETLINECOUNT = &HBA 注释：在程序中调用

LineCnt = SendMessage(ctl.hwnd, EM_GETLINECOUNT, 0, 0) 注释：LineCnt即为此TextBox的行数。 8、如何设置ListBox的水平卷动轴的宽度？

*API函数声明

Const LB_SETHORIZONTALEXTENT = &H194

Private Declare Function SendMessage Lib \\lParam As Any) As Long 注释：调用

Call SendMessage(List1.hwnd, LB_SETHORIZONTALEXTENT, 400, ByVal 0&) 注释：注意400是以象素为单位，你可以根据情况自行设定。 9、如何交换鼠标按键？

*API函数声明

Declare Function SwapMouseButton& Lib \)