How to change screen size of an external application using VBA

Question

I've tried the below code to adjust the screen size of Excel

Sub win()
Dim myWindow1 As Window, myWindow2 As Window
Set myWindow1 = ActiveWindow
Set myWindow2 = myWindow1.NewWindow
With myWindow1
    .WindowState = xlNormal
    .Top = 0
    .Left = 0
    .Height = Application.UsableHeight
    .Width = Application.UsableWidth * 0.25
End With
With myWindow2
    .WindowState = xlNormal
    .Top = 0
    .Left = (Application.UsableWidth * 0.25) + 1
    .Height = Application.UsableHeight
    .Width = Application.UsableWidth * 0.75
End With
End Sub

But i want to change the screen size of google chrome. How can i do without opening new Chrome application using shell ? I want to change the screen size of already opened Chrome Application

Answer 1

The current answers don't supply a way to resize the window relative to the size of the screen. Here's a way it could be done by adding the code below to a module and running UseSnapWindow :

'References:
' - https://stackoverflow.com/questions/51359645/how-to-change-screen-size-of-an-external-application-using-vba
' - https://www.exceltip.com/general-topics-in-vba/determine-the-screen-size-using-vba-in-microsoft-excel.html
' - https://www.reddit.com/r/vba/comments/99xita/how_do_i_get_the_exact_screen_coordinates_of_a/

Option Explicit
Option Private Module

'Declaring Windows API functions
Private Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As LongPtr

Private Declare PtrSafe Function GetSystemMetrics32 Lib "User32" Alias "GetSystemMetrics" ( _
    ByVal nIndex As Long) As Long
    
Private Declare PtrSafe Function DwmGetWindowAttribute Lib "dwmapi.dll" ( _
    ByVal Hwnd As LongPtr, _
    ByVal dwAttribute As Long, _
    ByRef pvAttribute As Any, _
    ByVal cbAttribute As Long) As Long
    
Public Declare PtrSafe Function SetWindowPos Lib "User32" ( _
    ByVal Hwnd As LongPtr, _
    ByVal hWndInsertAfter As LongPtr, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal cx As Long, _
    ByVal cy As Long, _
    ByVal wFlags As Long) As Long

'Declaring Constants/Enums
Public Const HWND_TOP As Long = 0           'Places the window at the top of the Z order.
Public Const SWP_SHOWWINDOW As Long = &H40  'Displays the window.

Public Enum SnapDirection
    SnapLeft = 0
    SnapRight = 1
End Enum

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Const DWMWA_EXTENDED_FRAME_BOUNDS As Long = 9

'Snap a window to the right or the left depending on SnapTo.
'The window will occupy the share of the screen as specified by ScreenFraction
Sub SnapWindow(WindowCaption As String, SnapTo As SnapDirection, ScreenFraction As Double)
    
    'Get the window handle
    Dim Hwnd As LongPtr
    Hwnd = FindWindow(vbNullString, WindowCaption)
    
    'Get screen dimensions
    Dim FullHeight As Long
    FullHeight = GetSystemMetrics32(1)
    Dim FullWidth As Long
    FullWidth = GetSystemMetrics32(0)
    
    'Calculate partial width
    Dim PartialWidth As Long
    PartialWidth = Int(ScreenFraction * FullWidth)
    
    'Calculate target left position
    Dim TargetLeftPosition As Long
    TargetLeftPosition = SnapTo * (FullWidth - PartialWidth)
    
    Dim rslt As Long
    'Moving/Resizing window
    rslt = SetWindowPos(Hwnd, HWND_TOP, TargetLeftPosition, 0, PartialWidth, FullHeight, SWP_SHOWWINDOW)
    
    'Apparently, Windows adds some invisible border to the window which causes the window to not fill the full space
    'By using DwmGetWindowAttribute, we are able to recover the actual window properties and can apply a correction
    Dim LeftAdjustment As Long
    LeftAdjustment = TargetLeftPosition - ActualLeftPosition(Hwnd)
    Dim RightAdjustment As Long
    RightAdjustment = PartialWidth - ActualWidth(Hwnd)
  
    'Apply correction
    rslt = SetWindowPos(Hwnd, HWND_TOP, TargetLeftPosition + LeftAdjustment, 0, PartialWidth + RightAdjustment, FullHeight, SWP_SHOWWINDOW)
    
End Sub

Function ActualLeftPosition(Hwnd As LongPtr)
    Dim ext As RECT
    Dim rslt As Long
    rslt = DwmGetWindowAttribute(Hwnd, DWMWA_EXTENDED_FRAME_BOUNDS, ext, LenB(ext))
    If rslt = 0 Then
        ActualLeftPosition = ext.Left
    End If
End Function

Function ActualWidth(Hwnd As LongPtr)
    Dim ext As RECT
    Dim rslt As Long
    rslt = DwmGetWindowAttribute(Hwnd, DWMWA_EXTENDED_FRAME_BOUNDS, ext, LenB(ext))
    If rslt = 0 Then
        ActualWidth = ext.Right - ext.Left
    End If
End Function

Sub UseSnapWindow()
    
    'This would correspond to the original question with a 25-75 ratio for the 2 windows
    SnapWindow "Caption Window 1", SnapLeft, 0.25
    SnapWindow "Caption Window 2", SnapRight, 0.75
    
End Sub

Answer 2

Update to 2022 and 64bit.

Option Explicit
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Sub SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)

Private Sub Resize_Chrome()
Dim ChromeHandle As Long
    ChromeHandle = FindWindow(vbNullString, "New Tab - Google Chrome")
    SetWindowPos ChromeHandle, 0, 0, 0, 1000, 600, &H40
End Sub

This will:

• Places the window at the top of the Z order.
• Position in upper left corner (0,0)
• With a 1000 pixels width by 600 pixels height (1000,600)
• Activate the window (&H40)

Important notes:

• The size is not changed if the window is maximized
• This looks for the Chrome window not a specific tab.
• The name of a Chrome window is the name of the active tab + " - Google Chrome".

Answer 3

You can use functions from the User32-library to control external windows. Here is an example for doing so for a Google Chrome "New Tab" window:

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Sub SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Private Sub Resize_Chrome()
Dim ChromeHandle As Long
ChromeHandle = FindWindow(vbNullString, "New Tab - Google Chrome")
SetWindowPos ChromeHandle, -1, 0, 0, 600, 600, &H10
End Sub

This sets the window to the upper left corner (0,0) with a 600 x 600 pixel size (600,600)

For more information on the SetWindowPos function, see https://msdn.microsoft.com/en-us/library/windows/desktop/ms633545%28v=vs.85%29.aspx?f=255&MSPPError=-2147217396