How to determine monitor size to centre text?

[TotallyConfused]

I am creating a Menu program, with the opening sheet titled, 'MAIN MENU'. I would like to have this centred on the monitor and I can do this on mine simply by visually positioning the words. My problem is that I have no idea of the horizontal length of the user's monitor. Is there any way my program could use VBA to determine the user's monitor size when the program is run, and then adjust the location of the title to fit that monitor's horizontal length? I assume this system information is stored by Windows someplace but I have no idea where or how to access it. I know the user is using MS Office 365 with Windows, but that is all I know.

To test an idea, I merged several cells together reaching across my secondary monitor, then instructed Excel to centre those two words. Worked great. Then I slid everything over to my laptop's much smaller screen hoping that somehow everything would be 'squeezed' together so it would fit on that screen. That didn't work and I ended up with only a couple of letters showing with the rest way off the right hand edge.

If there is no way to have VBA adjust the location, if I knew of some way to determine the size of a monitor, perhaps there is a way ( I hope ) that I could calculate the location so it would 'look good' on that monitor, regardless how it looked on mine. I won't be running the program. Possibly if I knew the physical size in inches of their screen, I could compare that to mine and figure out a relative starting point.

If anyone has any ideas, suggestions or better yet, some code, I sure would appreciate hearing from you. THANK YOU in advance for any help.

Sincerely,
TotallyConfused

 

[Eric W]

One idea. Let's say you want columns A:K to be visible. You can either merge cells A1:K1 and center the words "Main Menu" in it, or just put "Main Menu" in A1, then select A1:K1 and use the "Center across selection" option. Then use this code:

    Range("A1:K1").Select
    ActiveWindow.Zoom = True

That will center Main Menu (columns A:K) within the Excel window. Depending on how their window is sized, it still might look odd. You can also experiment with:

Application.WindowState = xlMaximized

which will maximize the Excel window, then use the previous code.

 

[TotallyConfused]

You're trying to make this sound as if it is a very complicated screen
@TotallyConfused - the questions are valid.

Hello Yongle

Yes, in most cases the questions being asked would not only be valid but also ones that would supply information that would have to be known by anyone working on this project. In my case, all I need to know is some way to calculate the position of the two words, MAIN MENU in the top row of the monitor. I'd like them to be more or less centred and not to far to the left or right. How to do that is the problem I'm asking for help on. The subroutine I was given earlier in this thread, displays the height and width of the screen, but in points. So far, I haven't found out how to convert that to width of letters. Even if I did,. I've never seen any VBA code that talks about columns in terms of points. There is nothing else being done at the moment. I'm just now starting to even think about creating some of the buttons, but I know how to do that.

If you feel it is necessary to see what I'm talking about, then you can easily create a similar screen.
1) Open up a new workbook.
2) Turn on your Caps Lock key.
3) Move the cursor to the top row of one of the blank sheets.
4) Type in the two words - MAIN MENU
5) Now you have created exactly what I'm talking about. Were you able to centre those two words and if so, how? It's easy to do that on your monitor, but remember, as I said in an earlier post, this program WILL NOT be run on my computer. I have NO idea what the size of the user's monitor will be. So, lets say you've created this MAIN MENU screen as I have described, but you are using a small screen and everything looks good. Now transfer this workbook to a computer with a much larger monitor, (or perhaps vice-versa) how will it look then?

I suppose if someone feels they really need a screen shot of a blank screen with only those two words at the top, I can try to send one, though I've never done that. In all honesty, I fail to see what help that will be to anyone.

Thank you for your response.
TotallyConfused

 

[TotallyConfused]

One idea. Let's say you want columns A:K to be visible. You can either merge cells A1:K1 and center the words "Main Menu" in it, or just put "Main Menu" in A1, then select A1:K1 and use the "Center across selection" option. Then use this code:

    Range("A1:K1").Select
    ActiveWindow.Zoom = True

That will center Main Menu (columns A:K) within the Excel window. Depending on how their window is sized, it still might look odd. You can also experiment with:

.WindowState = xlMaximized

which will maximize the Excel window, then use the previous code.

Hello Eric

Thank you for your suggestion. It's quite late here now, so I'll check out your suggestion in the morning. It certainly sounds intriguing.

TotallyConfused

 

[Jaafar Tribak]

You're trying to make this sound as if it is a very complicated screen, and it's NOT! What could be simpler than only two words?

The reason I asked to see an image of the sheet was to make sure that if I posted some code it wouldn't disturb any other existing data or interfere with the buttons you mentioned you have in the MAIN MENU sheet.

Certainly, placing two words in a cell accross the top is easy but, it is rather tricky to keep the text in the center of the screen while it is in a cell regardless of the current sheet zoom, screen resolution, font size, columns widths, application window max-min state .. etc all of which could be changed by the user and which should be taken into account before attempting to write any code.

You could try using Eric's suggestion (post#11) although that would unfortunately mess up the user's sheet zoom.

Below is some code that you may want to try... The code doesn't place the text in a cell, it places the text in a dynamically created TextBox (Shape). Also, the code uses a windows timer in order to dynamically adjust the text location and size whenever the zoom changes, the excel window is minimized\maximized , columns are added\deleted .. etc.

Since the code uses a windows timer, please, make sure that you stop the timer properly (use the StopTimer routine) should you want to edit the code while the timer is running.


Workbook Demo


1- Code in a Standard Module:

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function EnumDisplayMonitors Lib "user32" (ByVal hDC As LongPtr, lprcClip As Any, ByVal lpfnEnum As LongPtr, dwData As Long) As Long
#Else
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function EnumDisplayMonitors Lib "user32" (ByVal hDC As Long, lprcClip As Any, ByVal lpfnEnum As Long, dwData As Long) As Long
#End If

Private Const SHEET_NAME = "MAIN_MENU"                 '<== Change name as required.
Private Const TEXTBOX_NAME = "MainMenuTextBox"   '<== Change name as required.

Private bTimerSet As Boolean


Public Sub CENTER_MAIN_MENU_TEXT()

    If GetMonitorCount = 1 Then
        If Not bTimerSet Then
            Call FreezeTopRow
            If Not TextBoxExists(TEXTBOX_NAME) Then
                Call CreateTextBox(Sheets(SHEET_NAME))
            End If
            Call KillTimer(Application.hwnd, 0)
            bTimerSet = True
            Call SetTimer(Application.hwnd, 0, 0&, AddressOf TimerProc)
        End If
    End If

End Sub




'________________________________________Private Routines_______________________________________________

Private Sub TimerProc()

    Static oPrevVisblRng As Range

    On Error Resume Next
 
   If Not bTimerSet Then Call StopTimer: Exit Sub

   If oPrevVisblRng Is Nothing Then
      Set oPrevVisblRng = ActiveWindow.ActivePane.VisibleRange
   End If

    If ActiveSheet Is Sheets(SHEET_NAME) Then
        If oPrevVisblRng.Address <> ActiveWindow.ActivePane.VisibleRange.Address Then
            Set oPrevVisblRng = ActiveWindow.ActivePane.VisibleRange
            Call AdjustTextBox(Sheets(SHEET_NAME).Shapes(TEXTBOX_NAME))
        End If
    End If

End Sub

Private Sub StopTimer()
    Call KillTimer(Application.hwnd, 0)
    bTimerSet = False
    Debug.Print "Timer stopped."
End Sub

Private Sub FreezeTopRow()
            With ActiveWindow
                If Not .FreezePanes Then
                    Sheets(SHEET_NAME).Rows("2:2").Select
                    .FreezePanes = True
                    Sheets(SHEET_NAME).Cells(1).Select
                End If
            End With
End Sub

Private Sub CreateTextBox(ByVal Sheet As Worksheet)

Dim oTextBox As Object

With Sheet
    .Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 0, 0).Name = TEXTBOX_NAME
    Set oTextBox = .Shapes(TEXTBOX_NAME)
    With oTextBox
        .TextFrame2.VerticalAnchor = msoAnchorMiddle
        .TextFrame.VerticalOverflow = xlOartVerticalOverflowOverflow
        .TextFrame.Characters.Font.Color = RGB(255, 0, 0)
        .Line.Visible = msoFalse
        .Fill.Transparency = 0.9
    End With
    With oTextBox.TextFrame2.TextRange
        .Paragraphs.ParagraphFormat.Alignment = msoAlignCenter
        .Text = "Main Window"
        With .Font
            .Size = 16  '<= change font size as required.
            .Bold = True
            .Name = "Arial"
        End With
    End With
End With

Call AdjustTextBox(oTextBox)

End Sub

Private Sub AdjustTextBox(ByVal TextBox As Shape)

    Const SM_CYVSCROLL = 20
 
    With ActiveWindow.Panes(1)
        TextBox.Left = .VisibleRange.Left
        TextBox.Top = .VisibleRange.Top
        TextBox.Width = (Application.Width - IIf(ActiveWindow.DisplayVerticalScrollBar, _
                                    GetSystemMetrics(SM_CYVSCROLL), 0)) / (ActiveWindow.Zoom / 100)
        TextBox.Height = .VisibleRange.Rows(1).Height
    End With

End Sub

Private Function TextBoxExists(ByVal TextBoxName As String) As Boolean
    On Error Resume Next
    TextBoxExists = CBool(Sheets(SHEET_NAME).Shapes(TextBoxName).ID)
End Function

Private Function GetMonitorCount() As Long
    EnumDisplayMonitors ByVal 0, ByVal 0&, AddressOf MonitorEnumProc, GetMonitorCount
End Function

#If VBA7 Then
    Private Function MonitorEnumProc(ByVal hMonitor As LongPtr, ByVal hDCMonitor As LongPtr, ByVal lprcMonitor As LongPtr, dwData As Long) As Long
#Else
    Private Function MonitorEnumProc(ByVal hMonitor As Long, ByVal hDCMonitor As Long, ByVal lprcMonitor As Long, dwData As Long) As Long
#End If

    dwData = dwData + 1
    MonitorEnumProc = 1
 
End Function

Private Sub Auto_Close()
    Call StopTimer
End Sub

2-Code in the ThisWorkbook Module:

Option Explicit

Private Sub Workbook_Activate()
    If ActiveSheet Is Sheets("MAIN_MENU") Then
        Call CENTER_MAIN_MENU_TEXT
    End If
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh Is Sheets("MAIN_MENU") Then
        Call CENTER_MAIN_MENU_TEXT
    End If
End Sub