Excel VBA : Get hwnd value of a CommandButton

问题

I'm going nuts here...

How do you find the "hwnd" value of a CommandButton, in an Excel 2007 Form ?

I've Googled, I've tried all kinds of suggestions (most of which suggest that a command button has a .hwnd member property - but it doesn't) and haven't found an answer.

I can get the Form's hwnd value, and (in theory) should be able to use a EnumChildWindows to find sub-windows, including my button, but this also doesn't work.

Has anyone managed to do this ?

回答1:

I'm afraid you can't, MS Forms controls like CommandButtons are not windows at all, they are "Windowless controls" i.e they are drawn by the MS Forms Runtime onto the userform surface as purely graphical abstractions, so no HWND.

回答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

来源：https://stackoverflow.com/questions/9617553/excel-vba-get-hwnd-value-of-a-commandbutton

标签

excel

hwnd