excel - 查找列标题高度和行标题宽度

Question

这是对我之前的问题 here 的一种跟进，但足够不同，我觉得问一个新问题是最好的。我使用了一系列窗口句柄将用户窗体锁定到 Excel 电子表格，这导致 0,0 位置成为列和行标题(或“全选”按钮)的左上角。 tl;dr 是我试图找到如何确定列标题的高度和行标题的宽度，以便无论用户的默认 excel 字体如何，我都可以在页面上正确定位用户表单设置。

我认为我目前为我的用户表单编写的代码不会有帮助，但如果有人想看，我很乐意发布它。我可以通过将 DisplayHeadings 属性设置为 false 来完全删除标题，但这实际上对我的最终目标不起作用。

列标题的高度似乎等于具有相同字体类型和大小的单元格的默认高度。我还没有测试过这个方法，因为它只能给我所需的一半，但我仍然想确认这是否准确。

我还知道，当您在电子表格中向下移动时，行标题的宽度会发生变化(例如，首先增加 1,000，然后增加 10,000、100,000 和 1,000,000)。我只需要找到最小的宽度(一切都小于 1,000)，但我想知道如何找到更大的宽度，如果它不太复杂的话。

为了找到标题大小，我尝试通过以下代码在删除显示标题后比较单元格的 .left 和 .top 属性:

Sub TestHeadings()
   Dim fl, ft, tl, tt As Integer

   tl = Application.ActiveSheet.Range("A1").Left
   tt = Application.ActiveSheet.Range("A1").Top
   Application.ActiveWindow.DisplayHeadings = False
   fl = Application.ActiveSheet.Range("A1").Left
   ft = Application.ActiveSheet.Range("A1").Top

   Debug.Print "True: " & tl & ", " & tt
       'Returns True: 0, 0
   Debug.Print "False: " & fl & ", " & ft
       'Returns False: 0, 0

End Sub

在禁用显示标题后，我还尝试通过以下代码比较用户窗体(称为 Working_Menu，.StartUpPosition 属性设置为 0-Manul)的 .left 和 .top 属性:

Sub TestHeadings()
   Dim fl, ft, tl, tt As Integer

   Application.ActiveWindow.DisplayHeadings = False
   With Working_Menu
      .Left = 5 'Also tried 0
      .Top = 5 'Also tried 0
      .Show
    End With
   fl = Working_Menu.Left
   ft = Working_Menu.Top
   Application.ActiveWindow.DisplayHeadings = True
   tl = Working_Menu.Left
   tt = Working_Menu.Top

   Debug.Print "True: " & tl & ", " & tt 
       'Returns True: 5, 145, or 0, 140
   Debug.Print "False: " & fl & ", " & ft 
       'Returns False: 5, 144.75, or 0, 139.5 (Adjusted for screen resolution)

End Sub

我的结果在代码中有注释，但两种方法都没有返回任何指示 header 大小的差异。有谁知道如何确定列标题的高度或行标题的宽度？

谢谢!

Answer 1

此 Sub 将返回其参数 HeightPoints(以磅为单位的列标题高度)和 WidthPoints(以磅为单位的行标题宽度):

Sub HeadingsSize(ByRef HeightPoints As Single, ByRef WidthPoints As Single)
    Dim rC As Range, bSU As Boolean
    Dim x1 As Long, x2 As Long, y1 As Long, y2 As Long
    Const PxToPt As Single = 72 / 96
    bSU = Application.ScreenUpdating
    If bSU Then Application.ScreenUpdating = False
    With ActiveWindow
        Set rC = .VisibleRange.Cells(1)
        y1 = .PointsToScreenPixelsY(rC.Top)
        x1 = .PointsToScreenPixelsX(rC.Left)
        .DisplayHeadings = Not .DisplayHeadings
        y2 = .PointsToScreenPixelsY(rC.Top)
        x2 = .PointsToScreenPixelsX(rC.Left)
        .DisplayHeadings = Not .DisplayHeadings
    End With
    HeightPoints = Abs(y2 - y1) * PxToPt
    WidthPoints = Abs(x2 - x1) * PxToPt
    Application.ScreenUpdating = bSU
End Sub