我在这里疯了......
如何在Excel 2007表单中找到 CommandButton 的“hwnd”值?
我用谷歌搜索过,我已经尝试了各种建议(大多数建议命令按钮都有一个 .hwnd 成员属性 - 但它没有)并且没有找到答案。
我可以获取 Form的 hwnd值,并且(理论上)应该能够使用EnumChildWindows来查找子窗口,包括我的按钮,但这也不起作用。
有人设法做到了吗?
答案 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