none
Excel VBA : Change two window sizes to be a percent of the application window size RRS feed

  • Question

  • I have an Excel 2007 workbook that I have written code for to spawn a new window, make a certain worksheet active in that window and format it so I can see only the data I need to work with.

    I then position this newly spawned window next to the first window and adjust Windows("WorkbookName.xlsm:1").Activate to about 3/5 the screen size and Windows("WorkbookName.xlsm:2").Activate to approximately 2/5 the screen size.

    However, I need to run this on different computers with different size monitors / different screen resolutions.

    I have found code to tell me what my screen size is and I understand that measurements are handled differently both as pixels and points and that one pixel is roughly 3/4 point.

    I just can't figure out how to get these windows to align as a percentage of the screen size / application window itself?

    Thursday, November 17, 2011 8:02 PM

Answers

  • As you say you need to get the screen res' and the system's points to pixels using APIs. Typically the latter is "exactly" 72/96 or 3/4, though not if large fonts are set.

    However there's a bit more API/window work to do to get the sizes of the individual workbook's windows with respect to the inside of the main application window. However there's a totally different approach, try the following

    Sub CustomWindows()
    Dim cnt As Long, i As Long
    Dim wd As Single, lt As Single
    Dim wn As Window
    Dim wbMain As Workbook, wb As Workbook
            Set wbMain = Workbooks("Book2") '    << change Book2, eg WorkbookName.xlsm
            Application.WindowState = xlMaximized
         wbMain.Activate
            If wbMain.Windows.Count = 1 Then ActiveWindow.NewWindow
         For i = wbMain.Windows.Count To 3 Step -1
                 wbMain.Windows(i).Close
         Next
            ReDim arrWins(1 To Application.Windows.Count) As String
            For Each wb In Application.Workbooks
                 If Not wb Is ActiveWorkbook Then
                         For Each wn In wb.Windows
                                 If wn.Visible Then
                                         cnt = cnt + 1
                                         arrWins(cnt) = wn.Caption
                                         wn.Visible = False
                                 End If
                         Next
                 End If
         Next
            Application.Windows.Arrange ArrangeStyle:=xlVertical
         lt = 1234567
         For i = 1 To 2
                 wd = wbMain.Windows(i).Width + wd
                 If wbMain.Windows(i).Left < lt Then
                         lt = wbMain.Windows(i).Left
                 End If
         Next
            wbMain.Windows(1).Left = lt
         wbMain.Windows(1).Width = wd * 0.6    ' 3/5
         wbMain.Windows(2).Width = wd * 0.4    ' 2/5
         wbMain.Windows(2).Left = wbMain.Windows(1).Left +
    wbMain.Windows(1).Width
            For i = cnt To 1 Step -1
                 Application.Windows(arrWins(i)).Visible = True
         Next
            For i = 2 To 1 Step -1
                 wbMain.Windows(2).Activate
         Next
    
    End Sub

    Peter Thornton

    Friday, November 18, 2011 11:14 AM
    Moderator

All replies

  • As you say you need to get the screen res' and the system's points to pixels using APIs. Typically the latter is "exactly" 72/96 or 3/4, though not if large fonts are set.

    However there's a bit more API/window work to do to get the sizes of the individual workbook's windows with respect to the inside of the main application window. However there's a totally different approach, try the following

    Sub CustomWindows()
    Dim cnt As Long, i As Long
    Dim wd As Single, lt As Single
    Dim wn As Window
    Dim wbMain As Workbook, wb As Workbook
            Set wbMain = Workbooks("Book2") '    << change Book2, eg WorkbookName.xlsm
            Application.WindowState = xlMaximized
         wbMain.Activate
            If wbMain.Windows.Count = 1 Then ActiveWindow.NewWindow
         For i = wbMain.Windows.Count To 3 Step -1
                 wbMain.Windows(i).Close
         Next
            ReDim arrWins(1 To Application.Windows.Count) As String
            For Each wb In Application.Workbooks
                 If Not wb Is ActiveWorkbook Then
                         For Each wn In wb.Windows
                                 If wn.Visible Then
                                         cnt = cnt + 1
                                         arrWins(cnt) = wn.Caption
                                         wn.Visible = False
                                 End If
                         Next
                 End If
         Next
            Application.Windows.Arrange ArrangeStyle:=xlVertical
         lt = 1234567
         For i = 1 To 2
                 wd = wbMain.Windows(i).Width + wd
                 If wbMain.Windows(i).Left < lt Then
                         lt = wbMain.Windows(i).Left
                 End If
         Next
            wbMain.Windows(1).Left = lt
         wbMain.Windows(1).Width = wd * 0.6    ' 3/5
         wbMain.Windows(2).Width = wd * 0.4    ' 2/5
         wbMain.Windows(2).Left = wbMain.Windows(1).Left +
    wbMain.Windows(1).Width
            For i = cnt To 1 Step -1
                 Application.Windows(arrWins(i)).Visible = True
         Next
            For i = 2 To 1 Step -1
                 wbMain.Windows(2).Activate
         Next
    
    End Sub

    Peter Thornton

    Friday, November 18, 2011 11:14 AM
    Moderator
  • Peter,

    This is excellent - Thank you very much!

     

    Later-

    Ray

    Friday, November 18, 2011 4:48 PM
  • Hi Peter,

    I am working on a project that requires a similar section of code to yours but with a slight difference. Your code seems to replicate the first workbook to a second window and then the code easily manipulates the sizing.

    I however have two different workbooks that open at the same time within the window for example "Workbook1" "Workbook2".

    How would I amend the code to cater for two seperate workbooks being resized rather than just the 1 duplicated??

    Any help would be greatly appreciated.

    *Apologies is this actually requires a new thread, I am new to this forum so unsure of what needs a new thread and what doesn't.

    Kind Regards

    Nathan


    • Edited by Syris Sunday, February 19, 2012 12:37 AM
    Sunday, February 19, 2012 12:09 AM
  • Hello Nathan, you did well to dig this out!

    Is something like this what you are looking for -

    Sub CustomWindows2()
    ' show 2 workbook windows split 60:40 width
    Dim cnt As Long, i As Long
    Dim wd As Single, lt As Single
    Dim wn As Window
    Dim wb As Workbook
    Dim wb1 As Workbook, wb2 As Workbook
     '        << change to required names, eg "WorkbookName.xlsm"
         Set wb1 = Workbooks("Book2")
         Set wb2 = Workbooks("Book3")
            Application.WindowState = xlMaximized
         wb2.Activate
         wb1.Activate
         Application.Windows.Arrange ArrangeStyle:=xlVertical
            ReDim arrWins(1 To Application.Windows.Count) As String
         For Each wb In Application.Workbooks
                 If Not wb Is wb1 And Not wb Is wb2 Then
                         For Each wn In wb.Windows
                                 If wn.Visible Then
                                         cnt = cnt + 1
                                         arrWins(cnt) = wn.Caption
                                         wn.Visible = False
                                 End If
                         Next
                 End If
         Next
            Application.Windows.Arrange ArrangeStyle:=xlVertical
         lt = 1234567
            wd = wb1.Windows(1).Width
         wd = wb2.Windows(1).Width + wd
            If wb1.Windows(1).Left < lt Then
                 lt = wb1.Windows(1).Left
         End If
            wb1.Windows(1).Left = lt
         wb1.Windows(1).Width = wd * 0.6
         wb2.Windows(1).Width = wd * 0.4
         wb2.Windows(1).Left = wb1.Windows(1).Left + wb1.Windows(1).Width
         For i = cnt To 1 Step -1
                 Application.Windows(arrWins(i)).Visible = True
         Next
            wb2.Windows(1).Activate
         wb1.Windows(1).Activate
    End Sub

    Peter Thornton

    Tuesday, February 21, 2012 3:50 PM
    Moderator
  • I wonder if the above code could be adapted to work with additional monitor(s) with different resolution connected to the main unit. When I try using this version on such a monitor, it gets the width perfectly every time, however the height is always the one of the main monitor.

    I tried experimenting with 'Top' and 'Height' properties but all I achieved was Excel windows spread all over the place :)

    Regards,

    NaiA

    Thursday, March 17, 2016 10:22 AM