调整win64的ListBox高度声明的大小

时间:2016-09-09 08:57:26

标签: vba excel-vba excel

我发现了一段代码,可以让我的用户表单列表框根据输入的数量调整高度,但声明是针对win32而我不知道如何将其更改为正确赢得64,请帮忙。这是:

Option Explicit
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Any) As Long

Private Const LB_GETITEMHEIGHT = &H1A1


Public Function AutoSizeLBHeight(LB As Object) As Boolean
If Not TypeOf LB Is ListBox Then Exit Function
On Error GoTo ErrHandler
Dim lItemHeight As Long
Dim lRet As Long
Dim lItems As Long
Dim sngTwips As Single
Dim sngLBHeight As Single
If LB.ListCount = 0 Then
    LB.Height = 125
    AutoSizeLBHeight = True
Else
    lItems = LB.ListCount
    lItemHeight = SendMessage(LB.hwnd, LB_GETITEMHEIGHT, 0&, 0&)
    If lItemHeight > 0 Then
        sngTwips = lItemHeight * Screen.TwipsPerPixelY
        sngLBHeight = (sngTwips * lItems) + 125
        LB.Height = sngLBHeight
        AutoSizeLBHeight = True
    End If
End If
ErrHandler:
End Function

2 个答案:

答案 0 :(得分:1)

http://www.jkp-ads.com/articles/apideclarations.asp拥有您需要的一切。

  

SendMessage API是一个很好的例子,因为它使用两种类型:

32-bit:
Public Declare Function SendMessageA Lib "user32" ( _
    ByVal hWnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, lParam As Any) As Long

64 bit:
Public Declare PtrSafe Function SendMessageA Lib "user32" ( _
    ByVal hWnd As LongPtr, ByVal wMsg As Long, _
    ByVal wParam As Long, lParam As Any) As LongPtr
  

第一个参数-hWnd-是一个窗口句柄,它是内存中的一个地址。返回值是指向函数的指针,该函数也是内存中的地址。这两个必须在64位VBA中声明为LongPtr。参数wMsg和wParam用于传递数据,因此它们在32位和64位都可以是Long。

但是你知道64bit-Excel只需要这个,而不是64bit-Windows吗?

答案 1 :(得分:1)

使用编译器指令将允许代码在任一平台上正常运行。

#If Win64 Then

Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, _
                                                           ByVal wParam As LongPtr, lParam As Any) As LongPtr
#ElseIf Win32 Then

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
#End If