【源码】声明32位和64位Access、Excel等VBA兼容的API函数的方法

1.在声明中加上  PtrSafe 关键字
2.加上VBA7 及Win64的判断
Declare 语句 PtrSafe 关键字(可参考VBA帮助)
带有 PtrSafe 关键字的 Declare 语句为建议的语法。要使包括 PtrSafe 的 Declare 语句能同时在 32 位和 64 位平台上的 VBA7 开发环境中正确运行,必须先将 Declare 语句中所有需要存储 64 位数的数据类型(参数和返回值)更新为使用 LongLong(对于 64 位整数)或 LongPtr(对于指针和句柄)。为确保与 VBA 版本 6 和更早版本的向后兼容性,请使用下面的构造:

#If Vba7 Then
Declare PtrSafe Sub...
#Else
Declare Sub...
#EndIf

示例1:

#If VBA7 Then  ' 64位

    Private Declare PtrSafe Function apisndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

    Private Declare PtrSafe Function apiPlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long

#Else

    Private Declare Function apisndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

    Private Declare Function apiPlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long

#End If

'声明32位和64位Access Excel等VBA兼容的API函数

'当VBA7和Win64都是True时(只有64的Excel才是这种情况),使用第一条Declare语句。在其他版本中,使用第二条Declare语句

#If VBA7 And Win64 Then

    Declare ptSafe Function GetWindowsDirectory Lib "kernel32" (ByVal ipBuffer As String, ByVal nSize As Long) As Long

#Else

    Declare Function GetWindowsDirectory Lib "kernel32" (ByVal ipBuffer As String, ByVal nSize As Long) As Long

#End If



GetWindowsDirectory()

说明

这个函数能获取Windows目录的完整路径名。在这个目录里,保存了大多数windows应用程序文件及初始化文件

返回值

Long类型,复制到lpBuffer的一个字串的长度。如lpBuffer不够大,不能容下整个字串,就会返回lpBuffer要求的长度,零表示失败。并且将出错的信息存储在GetLastError函数中,用户可以通过调用GetLastError来得到错误信息。

参数表

参数 类型及说明

lpBuffer String,指定一个字串缓冲区,用于装载Windows目录名。除非是根目录,否则目录中不会有一个中止用的“\”字符

nSize Long,lpBuffer字串的最大长度

​'获取Windows文件夹路径

privateDeclare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long'在form窗体中声明改函数

Dim SWinDir As String '定义字符变量用来存储路径

Dim Retn As Long ‘定义长整型变量存储路径的长度

SWinDir = Space(255)’设定一个空串,长度为windows允许的最大长度,也可写作:SWidir=String(255,0)

Retn = GetWindowsDirectory(SWinDir, Len(SWinDir))‘获取windows路径的长度,swindir存储了路径

SWinDir = Left(SWinDir, Retn)’去掉空白内容。

示例2

#If VBA7 Then

'定义窗体样式

Private Declare PtrSafe Function FindWindow Lib "user32" Alias _

    "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias _

    "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

#Else

'定义窗体样式

Private Declare Function FindWindow Lib "user32" Alias _

    "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function SetWindowLong Lib "user32" Alias _

    "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

#End If

经过以上处理, 在office2003、2007和2010版本 office2013、xp以上系统均可正常运行。

示例3

If VBA7Then

    Public Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongLong

    Public Declare PtrSafe Function ClientToScreen Lib "user32" (ByVal hWnd As LongLong, lpPoint As POINTAPI) As LongLong

    Public Popup_Menu       As CommandBar       '指定弹出式菜单

    Public LastSelect_Menu  As MSForms.Image    '最后选择的菜单

    Public MenuCount        As Integer          '子菜单数量

    Public hForm            As Long             '窗口句柄

    Public intLevel         As Integer          '级别标识,用于设置Radio菜单(游戏菜单中:初级,中级,高级)

    Public bAbortEnabled    As Boolean          '标识放弃菜单项是否可用

    Public bItemCheck       As Boolean          '标识音效菜单是否CheckOn

    Public bMenuSelected    As Boolean          '标识菜单是否点击

    Public pt               As POINTAPI         '定义点

    Public faceid As Integer                    '图标ID

    Public faceidselect As Integer              '选择的图标

    Public fistid As Integer                    '第一个图标号

    Public lastid As Integer                    '最后一个图标号

    Public selectrow, selectcol As Integer

    Public Mcro(50) As String

    Public Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As LongLong, ByVal nIndex As LongLong) As LongLong

    Public Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As LongLong, ByVal nIndex As LongLong, ByVal dwNewLong As LongLong) As LongLong

    Public Const GWL_STYLE = (-16)

    Public Const WS_THICKFRAME As Long = &H40000     '(回復大小)

    Public Const WS_MINIMIZEBOX As Long = &H20000    '(最小化)

    Public Const WS_MAXIMIZEBOX As Long = &H10000    '(最大化)

Else

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

    Public Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long

    Public Popup_Menu       As CommandBar       '指定弹出式菜单

    Public LastSelect_Menu  As MSForms.Image    '最后选择的菜单

    Public MenuCount        As Integer          '子菜单数量

    Public hForm            As Long             '窗口句柄

    Public intLevel         As Integer          '级别标识,用于设置Radio菜单(游戏菜单中:初级,中级,高级)

    Public bAbortEnabled    As Boolean          '标识放弃菜单项是否可用

    Public bItemCheck       As Boolean          '标识音效菜单是否CheckOn

    Public bMenuSelected    As Boolean          '标识菜单是否点击

    Public pt               As POINTAPI         '定义点

    Public faceid As Integer                    '图标ID

    Public faceidselect As Integer              '选择的图标

    Public fistid As Integer                    '第一个图标号

    Public lastid As Integer                    '最后一个图标号

    Public selectrow, selectcol As Integer

    Public Mcro(50) As String

    Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

    Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

    Public Const GWL_STYLE = (-16)

    Public Const WS_THICKFRAME As Long = &H40000     '(回復大小)

    Public Const WS_MINIMIZEBOX As Long = &H20000    '(最小化)

    Public Const WS_MAXIMIZEBOX As Long = &H10000    '(最大化)

End If

原作者: 盗梦

转载自:http://www.office-cn.net/article-15049-1.html

猜你喜欢

转载自blog.csdn.net/qingxikeren/article/details/84064995