Excel VBA：获取命令按钮的 hwnd 值

Question

我要疯了……

如何在 Excel 2007 表单中找到 CommandButton 的“hwnd”值？

我在 Google 上搜索过，我尝试了各种建议（其中大部分建议命令按钮具有 .hwnd 成员属性 - 但它没有）并且没有找到一个答案。

我可以获得 Form 的 hwnd 值，并且（理论上）应该能够使用 EnumChildWindows 来查找子窗口，包括我的按钮，但这也不起作用。

有人能做到吗？

Answer 1

恐怕你不能，像 CommandButtons 这样的 MS Forms 控件根本不是 窗口，它们是“无窗口控件”，即它们是由 MS Forms Runtime 绘制到用户窗体表面上的纯图形抽象，所以没有 HWND。

Answer 2

' this may format    
' in a worksheet have driver buttons for

Option Explicit: Option Compare Text

Private Sub ControlsDet_Click()
LookFrames
End Sub

Private Sub PaintValid_Click()
PaintAll
End Sub

Private Sub ShowForm_Click()
    UFS.Show False
End Sub

Private Sub TextON_Click()
DoTextOn
End Sub
' then have a form  UFS and put in some controls from the tool box
'put in frames and listboxes and whatever
.
.have a code module as
        Option Explicit: Option Compare Text
'
'http://www.tek-tips.com/viewthread.cfm?qid=1394490
'
' to look at the useage of    CtrlName.[_GethWnd]  function
'  VB has a function   for hWnd but VBA hides its  brother as [_GetwHnd]
'  in VBA there are haves and have_nots
' better than finding each control's position in pixels and then using
'Private Declare Function WindowFromPoint& Lib "user32" (ByVal xPoint&, ByVal yPoint&)
'
'
Type RECT  ' any type with 4 long int will do
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
'
Type RECTxy
    X1 As Long
    Y1 As Long
    X2 As Long
    Y2 As Long
End Type
'
' OK as Private here or public elsewhere
'
Declare Function GetClientRect& Lib "User32.dll" (ByVal hwnd&, ByRef lpRECT As RECTxy)
Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Declare Function DeleteObject& Lib "gdi32" (ByVal hndobj&)
Declare Function FillRectXY& Lib "User32.dll" Alias "FillRect" (ByVal Hdc&, lpRECT As RECTxy, ByVal hBrush&)
Declare Function GetDC& Lib "user32" (ByVal hwnd&)
Declare Function DeleteDC& Lib "gdi32" (ByVal hwnd&)
Declare Function TextOut& Lib "GDI32.dll" Alias "TextOutA" (ByVal Hdc&, ByVal x&, ByVal y&, _
                                                            ByVal lpString$, ByVal nCount&)

Function RndPale&(Optional R% = 150, Optional G% = 170, Optional B% = 140)
    RndPale = RGB(R + Rnd() * (250 - R), G + Rnd() * (255 - G), B + Rnd() * (250 - G))
End Function
Sub PaintAll()
    Dim Wc As Control
    For Each Wc In UFS.Controls
        Showrec Wc
    Next Wc
End Sub
Sub Showrec(WCtrl As Control)

    Dim hBrush&, Outwr As RECTxy, WCtrlhWnd&, WCtrlHDC&
    WCtrlhWnd = WCtrl.[_GethWnd]
    If WCtrlhWnd <> 0 Then  ' has handle
        WCtrlHDC = GetDC(WCtrlhWnd)
        GetClientRect WCtrlhWnd, Outwr
        hBrush = CreateSolidBrush(RndPale)
        FillRectXY WCtrlHDC, Outwr, hBrush
        DeleteObject hBrush
        DeleteDC WCtrlHDC
        DeleteObject WCtrlhWnd
    End If
End Sub

Sub LookFrames()

    Dim WCtrl As Control, rI%, Ra As Range
    Dim Outwr As RECTxy, WCtrlhWnd&
    Set Ra = ActiveSheet.Range("e4:r30")
    Ra.NumberFormat = "0.0"
    Ra.ClearContents
    UFS.Show False
    rI = 4
    For Each WCtrl In UFS.Controls
        WCtrlhWnd = WCtrl.[_GethWnd]
        rI = rI + 1
        Cells(rI, 5) = WCtrl.Name
        Cells(rI, 6) = TypeName(WCtrl)
        Cells(rI, 7) = WCtrlhWnd
        Cells(rI, 8) = WCtrl.Left
        Cells(rI, 9) = WCtrl.Top

        Cells(rI, 10) = WCtrl.Width
        Cells(rI, 11) = WCtrl.Height
        If WCtrlhWnd <> 0 Then
            GetClientRect WCtrlhWnd, Outwr
            Cells(rI, 12) = Outwr.X1
            Cells(rI, 13) = Outwr.Y1
            Cells(rI, 14) = Outwr.X2
            Cells(rI, 15) = Outwr.Y2
            DeleteObject WCtrlhWnd

        End If
    Next WCtrl
    Ra.Columns.AutoFit

End Sub
Sub DoTextOn()
    UFS.Show False

    Dim WHnd&, FHdc&, Tout$, Wc As Control

    For Each Wc In UFS.Controls
        WHnd = Wc.[_GethWnd]
        If WHnd <> 0 Then
            FHdc = GetDC(WHnd)
            Tout = Wc.Name & " as " & WHnd

            TextOut FHdc, 10, 20, Tout, Len(Tout)


            DeleteDC FHdc
            DeleteObject WHnd
        End If
    Next Wc
End Sub