如何使弹出窗口的左上角对准选中的单元格的右下角？【已解决】

向東

我写了一段代码，
点击第一列单元格就会弹出对话窗口，
可是对话窗口UserForm1每次都是在Excel窗口的中间，
即使设置UserForm1的属性StartUpPosition为手动，
然后在Worksheet_SelectionChange事件中，
UserForm1.Top = Target.Top
UserForm1.Left = Target.Offset(0, 1).Left
还是不行，特别是行数多了，
窗口弹出后就没影了！

请高人指教！


清风_II版主提供的代码：

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. 
   
3.     Dim rng As Range, X As Single, Y As Single
   
4.     Set rng = ActiveCell
   
5.     With ActiveWindow
   
6.         X = .PointsToScreenPixelsX((rng.Left + rng.Width) * 4 / 3)
   
7.         Y = .PointsToScreenPixelsY((rng.Top + rng.Height) * 4 / 3)
   
8.     End With
   
9.    
   
10.     With UserForm1
    
11.         If .Visible = False Then .Show 0
    
12.         .Caption = "当前活动单元格:" & rng.Address
    
13.         .Move X * 3 / 4, Y * 3 / 4
    
14.     End With
    
15.     Set rng = Nothing
    
16. 
    
17. End Sub

复制代码

评论：
oobird版主的代码缺乏灵活性，对于行高不同的表格，弹出窗口将会参差不齐；
清风_ll 版主的代码较灵活适用性强。

但是，共同存在的问题是，如果有冻结窗格，弹出窗口还是不能很好的对齐。

小fisher 说：
代码要想通用的话，需要考虑以下几个因素：
1。滚动
2。拆分窗口
3。冻结窗格
4。显示比例
非常麻烦

确实麻烦！
特别是PointsToScreenPixelsX和PointsToScreenPixelsY两个方法，
至今没弄明白在冻结窗格时，是如何用的。
以下为解决代码，拆分没考虑，解决了滚动、冻结，
显示比例就选默认的96 DPI，不折腾了，这样就够实用的了。

1. 
   
2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
3.     Dim x As Single, y As Single
   
4.     Dim Pances1Row As Long, Pances1Col As Long
   
5.     Pances1Row = ActiveWindow.Panes(1).VisibleRange.Rows.Count
   
6.     Pances1Col = ActiveWindow.Panes(1).VisibleRange.Columns.Count
   
7.         
   
8.     With ActiveWindow
   
9.         If .FreezePanes = False Then '当没有冻结窗格
   
10.                 x = .PointsToScreenPixelsX((.Selection.Left + .Selection.Width) * 4 / 3) '4/3为像素转换为磅的系数，当DPI设置为96时，即4个像素为3磅。
    
11.                 y = .PointsToScreenPixelsY((.Selection.Top + .Selection.Height) * 4 / 3)
    
12.         Else
    
13.              If .Panes.Count = 2 Then '如果有两个Panes冻结窗格
    
14.                  If .Selection.Row > Pances1Row Then  '上下分的时候，如果选中的单元格在下边的Panes(2)中
    
15.                      x = .PointsToScreenPixelsX((.Selection.Left + .Selection.Width) * 4 / 3)
    
16.                      y = .PointsToScreenPixelsY((.Selection.Top + .Selection.Height) * 4 / 3) + (.Panes(1).VisibleRange.Rows.Height + 14.25) * 4 / 3 '14.25 Point为默认的一个行高值。
    
17.                  ElseIf .Selection.Column > Pances1Col Then '左右分的时候，如果选中的单元格在右边的Panes(2)中
    
18.                      x = .PointsToScreenPixelsX((.Selection.Left + .Selection.Width) * 4 / 3) + (.Panes(1).VisibleRange.Columns.Width + 25.4) * 4 / 3 '25.4 Point为测试得到的一个值。
    
19.                      y = .PointsToScreenPixelsY((.Selection.Top + .Selection.Height) * 4 / 3)
    
20.                  Else '其他就是在Panes(1)中
    
21.                      x = .PointsToScreenPixelsX((.Selection.Left + .Selection.Width) * 4 / 3)
    
22.                      y = .PointsToScreenPixelsY((.Selection.Top + .Selection.Height) * 4 / 3)
    
23.                  End If
    
24.              Else '其他就是有四个Panes冻结窗格的情况
    
25.                  If .Selection.Row > Pances1Row And .Selection.Column > Pances1Col Then  '如果选中的单元格在右下Panes
    
26.                      x = .PointsToScreenPixelsX((.Selection.Left + .Selection.Width) * 4 / 3) + (.Panes(1).VisibleRange.Columns.Width + 25.4) * 4 / 3
    
27.                      y = .PointsToScreenPixelsY((.Selection.Top + .Selection.Height) * 4 / 3) + (.Panes(1).VisibleRange.Rows.Height + 14.25) * 4 / 3
    
28.                  ElseIf .Selection.Row > Pances1Row And .Selection.Column <= Pances1Col Then '如果选中的单元格在左下Panes
    
29.                      x = .PointsToScreenPixelsX((.Selection.Left + .Selection.Width) * 4 / 3)
    
30.                      y = .PointsToScreenPixelsY((.Selection.Top + .Selection.Height) * 4 / 3) + (.Panes(1).VisibleRange.Rows.Height + 14.25) * 4 / 3
    
31.                  ElseIf .Selection.Row <= Pances1Row And .Selection.Column > Pances1Col Then '如果选中的单元格在右上Panes
    
32.                      x = .PointsToScreenPixelsX((.Selection.Left + .Selection.Width) * 4 / 3) + (.Panes(1).VisibleRange.Columns.Width + 25.4) * 4 / 3
    
33.                      y = .PointsToScreenPixelsY((.Selection.Top + .Selection.Height) * 4 / 3)
    
34.                  Else '其他就是选中的单元格在左上Panes(1)中
    
35.                      x = .PointsToScreenPixelsX((.Selection.Left + .Selection.Width) * 4 / 3)
    
36.                      y = .PointsToScreenPixelsY((.Selection.Top + .Selection.Height) * 4 / 3)
    
37.                  End If
    
38.              End If
    
39.          End If
    
40.     End With
    
41.    
    
42.     With UserForm1
    
43.         If .Visible = False Then .Show 0
    
44.         .Move x * 3 / 4, y * 3 / 4  'Move 方法，参数为单精度值，以磅为单位。
    
45.     End With
    
46. End Sub

复制代码

[ 本帖最后由 向東 于 2009-6-7 10:34 编辑 ]

蓝桥玄霜

先要设置
UserForm1.StartUpPosition=0

向東

原帖由 蓝桥玄霜 于 2009-5-31 09:51 发表
先要设置
UserForm1.StartUpPosition=0

已经说设置StartUpPosition为手动了，手动即是值为0，所有者中心为1，屏幕中心为2，窗口缺省为3.

该如何写这个代码才能控制住UserForm1的显示位置？

请高人出手！

向東

这个问题到底能不能解决？

oobird

试试这文件

向東

感谢版主提供的代码！

[ 本帖最后由 向東 于 2009-6-1 12:28 编辑 ]

清风_ll

向東

原帖由 oobird 于 2009-5-31 21:57 发表
试试这文件

1. 
   
2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
3. If Target.Row < 28 Then
   
4.     UserForm1.Top = Target.Top + 100
   
5.     UserForm1.Left = Target.Offset(0, 1).Left + 30
   
6.     UserForm1.Show 0
   
7. Else
   
8.     r = Target.Row - ActiveWindow.ScrollRow + 1 'ScrollRow 属性,返回或设置指定窗格或窗口最上面的行号。Long 类型，可读写。
   
9.     UserForm1.Top = Cells(r, 1).Top + 100
   
10.     UserForm1.Left = Target.Offset(0, 1).Left + 30
    
11.     UserForm1.Show 0
    
12. End If
    
13. End Sub
    

复制代码

[url=]示例[/url]本示例将第十行移到窗口的最上面。

1. Worksheets("Sheet1").Activate
   
2. ActiveWindow.ScrollRow = 10
   

复制代码

向東

原帖由 清风_ll 于 2009-5-31 23:02 发表

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. 
   
3.     Dim rng As Range, X As Single, Y As Single
   
4.     Set rng = ActiveCell
   
5.     With ActiveWindow
   
6.         X = .PointsToScreenPixelsX((rng.Left + rng.Width) * 4 / 3)
   
7.         Y = .PointsToScreenPixelsY((rng.Top + rng.Height) * 4 / 3)
   
8.     End With
   
9.    
   
10.     With UserForm1
    
11.         If .Visible = False Then .Show 0
    
12.         .Caption = "当前活动单元格:" & rng.Address
    
13.         .Move X * 3 / 4, Y * 3 / 4
    
14.     End With
    
15.     Set rng = Nothing
    
16. 
    
17. End Sub
    

复制代码

不明白
X = ActiveWindow.PointsToScreenPixelsX((rng.Left + rng.Width) * 4 / 3)
还有
UserForm1.Move X * 3 / 4, Y * 3 / 4

987654321

5楼6楼二位版主太牛了,