Finding Column Header Height and Row Header Width

Question

This is kind of a follow-up to my previous question here, but different enough I felt that asking a new question would be best. I have used a series of window handles to lock a userform to the Excel spreadsheet, which causes the 0,0 position to be the top left of the column and row headers (or the "select all" button). The tl;dr of this is that I'm trying to find how to determine the height of the column headers, and the width of the row headers, so that I can position a userform correctly on a page regardless of the user's default excel font settings.

I don't think the code that I have so far for my userform will be helpful, but I'm happy to post it if anyone would like to see. I can remove the headings altogether by setting the DisplayHeadings property to false, but this doesn't really work for my end goal.

It does seem like the height of the column header would be equal to the default height of a cell with the same font type and size. I haven't tested this method since it would only give me half of what I need, but I would still like to confirm if this is accurate.

I also know that the width of the row header will change the further you go down on the spreadsheet (eg. first increasing at 1,000, and then 10,000, 100,000, and 1,000,000). I only need to find the smallest width (everything less than 1,000), but I would like to know how to find a larger width if it's not too complicated.

To locate the header size, I have tried comparing a cell's .left and .top properties after removing the display headings through the following code:

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

I have also tried comparing a userform's (called Working_Menu, the .StartUpPosition property is set to 0-Manul) .left and .top properties after disabling the display headings, through the following code:

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

My results are commented in the code, but neither approach returned any differences indicating a header size. Does anyone have any idea how I can determine the height of the column header, or the width of the row header?

Thanks!

Answer 1

This Sub will return its parameters HeightPoints (column header height in points) and WidthPoints (row header width in points):

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