如果取得窗体里文本框的屏幕位置

exaction

最近做了一个用户窗体，功能是在日历窗体选择日期，然后赋值给窗体里的文本框。设计基本达到了预想的效果。但是一个问题没有解决好，就是弹出的日历窗体没有跟在文本框的下边。见图1 ，想要的效果见图2 。具体的问题描述见VBE里的代码，哪位老师帮忙修改一下代码，使得达到图2的效果，在此先谢过了。
MyCalendar.rar (24.92 KB, 下载次数: 178)

2017-5-19 00:12 上传

点击文件名下载附件

microyip

需要算出文本框2的application的屏幕位置才能定位

huang1314wei

excel自带日历控件的

小fisher

VBA中的文框控件是没有句柄的，因此用apiFocus获取到的其实是文本框父级对象（如窗体、Frame等有句柄的对象）的句柄，这样一来，日历窗体对齐的其实是窗体的左下角。
要对齐到文本框，可以用下面的代码（注意：没考虑多层嵌套的情况，例如：窗体->Frame->文本框）：

1. Option Explicit
   
2. 
   
3. Public gtxtDateInput As MSForms.TextBox     '接受输入日期的文本框
   
4. Public sDate     '选择的日期
   
5. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   
6. 
   
7. 
   
8. Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
   
9. Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
   
10. 
    
11. Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    
12. Private Const SM_CYCAPTION = 4
    
13. Private Const SM_CXDLGFRAME = 7
    
14. Private Const SM_CXFRAME = 32
    
15. 
    
16. Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
    
17. Private Const LOGPIXELSX = 88        '  Logical pixels/inch in X
    
18. 
    
19. '===============================================================================================
    
20. '-函数名称：    CalendarFor
    
21. '-功能描述：    打开日历窗体，选择相应的日期并赋值给指定文本框
    
22. '-输入参数：    DateInputCtl    必需的，要赋值的日期文本框对象
    
23. '-返回参数：    返回从日历窗口中选择的日期
    
24. '-其它说明：
    
25. '-使用注意：    此函数必须和日历窗体MyCalendar一起配合使用
    
26. '-返回参数：    无
    
27. '-使用示例：    CalendarFor Me.txtTextBox
    
28. '-相关调用：
    
29. '-创建日期：    2017-5-18
    
30. '===============================================================================================
    
31. Public Function CalendarFor(DateInputCtl As MSForms.TextBox)
    
32. 
    
33.     Set gtxtDateInput = DateInputCtl
    
34.     Dim hDC As Long, res As Long, borderWidth As Long, captionHeight As Long
    
35.     Dim lStyle As Long
    
36.    
    
37.    
    
38.     '获取屏幕DPI（屏幕分辨率,即每英寸像素数）--因为windows API的长度单位是像素，而VBA的长度单位是磅（1磅=1/72英寸），所以需要先获取DPI以便单位转换
    
39.     hDC = GetDC(0)
    
40.     res = GetDeviceCaps(hDC, LOGPIXELSX)
    
41.     ReleaseDC 0, hDC
    
42. 
    
43.     '获取窗体边框宽度
    
44.     borderWidth = GetSystemMetrics(SM_CXFRAME)
    
45.    
    
46.     '获取窗体标题栏高度
    
47.     captionHeight = GetSystemMetrics(SM_CYCAPTION)
    
48. 
    
49. 
    
50.     With MyCalendar
    
51.         '让日历窗体的左边距等于窗口的左边距 + 文本控件的左边距
    
52.         .Left = DateInputCtl.Parent.Left + DateInputCtl.Left + borderWidth * 72 / res
    
53.         
    
54.         '让日历窗体的上边路等于窗口的上边距 + 文本控件的上边距 + 文本控件的高度
    
55.         '(注：在Aero主题下，可能窗体边框会宽出来一块，盖住文本框下方几个像素)
    
56.         .Top = DateInputCtl.Parent.Top + DateInputCtl.Top + DateInputCtl.Height + (borderWidth + captionHeight) * 72 / res
    
57.         .Show
    
58.     End With
    
59. End Function

复制代码

exaction

huang1314wei 发表于 2017-5-19 08:25
excel自带日历控件的

Excel自带的日历控件，在64位操作系统是不能使用的，代码会报错

huang1314wei

exaction 发表于 2017-5-19 17:11
Excel自带的日历控件，在64位操作系统是不能使用的，代码会报错

可以用的，我的电脑就是64位的win10,日历控件注册一下就可以用了  
跟你操作系统没有关系，而是跟你使用的office 是32位还是64位有关，建议安装32位的office，这样大部分控件都可以用的  

exaction

小fisher 发表于 2017-5-19 14:08
VBA中的文框控件是没有句柄的，因此用apiFocus获取到的其实是文本框父级对象（如窗体、Frame等有句柄的对象 ...

谢谢小fisher哥的热心解答，完美解决位置对齐的问题。

cunz

感谢分享。

charki

huang1314wei 发表于 2017-5-19 17:19
可以用的，我的电脑就是64位的win10,日历控件注册一下就可以用了  
跟你操作系统没有关系，而是跟你使用 ...

怎么注册？