Excel VBA:获取CommandButton的hwnd值

时间:2012-03-08 12:18:10

标签: excel hwnd

我在这里疯了......

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

我用谷歌搜索过,我已经尝试了各种建议(大多数建议命令按钮都有一个 .hwnd 成员属性 - 但它没有)并且没有找到答案。

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

有人设法做到了吗?

2 个答案:

答案 0 :(得分:1)

我担心你不能,像CommandButtons这样的MS Forms控件根本不是而不是窗口,它们是“无窗口控件”,即它们被MS Forms Runtime绘制到userform表面上纯粹的图形抽象,所以没有HWND。

答案 1 :(得分:0)

' 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