Chrome 如何使用VBA更改外部应用程序的屏幕大小

6rvt4ljy  于 2023-08-01  发布在  Go
关注(0)|答案(3)|浏览(136)

我已经尝试了下面的代码来调整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

字符串
但是我想改变谷歌Chrome的屏幕尺寸。我怎么能不使用shell打开新的Chrome应用程序呢?我想更改已打开的Chrome应用程序的屏幕大小

x6yk4ghg

x6yk4ghg1#

您可以使用User32库中的函数来控制外部窗口。下面是一个例子,这样做的谷歌Chrome浏览器“新标签”窗口:

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

字符串
这将窗口设置为左上角(0,0),像素大小为600x600(600,600)
有关SetWindowPos函数的更多信息,请参见https://msdn.microsoft.com/en-us/library/windows/desktop/ms633545%28v=vs.85%29.aspx?f=255&MSPPError=-2147217396

xoefb8l8

xoefb8l82#

更新到2022和64位。

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

字符串
这将:

  • 将窗放置在Z顺序的顶部。
  • 左上角位置(0,0)
  • 宽度为1000像素,高度为600像素(1000,600)
  • 激活窗口(&H40)

重要注意事项:

  • 如果窗口最大化,则大小不会更改
  • 这将查找Chrome窗口,而不是特定的选项卡。
  • Chrome窗口的名称是活动标签的名称+“- Google Chrome”。
ao218c7q

ao218c7q3#

目前的答案不提供一种方法来调整窗口相对于屏幕的大小。这里有一种方法,可以通过将下面的代码添加到模块并运行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

字符串

相关问题